home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / node2src.zip / RBBSSUB2.BAS < prev    next >
BASIC Source File  |  1990-12-21  |  145KB  |  4,137 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB2.BAS CPC17.3, Copyright 1986 - 90 by D. Thomas Mack'
  3. '  Copyright 1990 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB2.BAS
  5. '  First Released .....: February 4, 1990
  6. '  Subsequent Releases.:
  7. '  Copyright ..........: 1986 - 1990
  8. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  9. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  10. '     require error trapping are incorporated within RBBSSUB 2-5 as
  11. '     separately callable subroutines in order to free up as much
  12. '     code as possible within the 64WasK code segment used by RBBS-PC.BAS.
  13. '  Parameters..........: Most parameters are passed via a COMMON statement.
  14. '
  15. ' Subroutine  Line               Function of Subroutine
  16. '   Name     Number
  17. '  Macro          1320  Check/execute macro
  18. '  AnswerIt        200  Answer the telephone when it rings
  19. '  ASCIICodes      129  Allow a CONFIG string to have any ASCII value
  20. '  BadChar         455  Check user name for invalid characters
  21. '  BadName       20235  Check for system crash attempt with bad file name
  22. '  Baud450        5507  Allow 300 baud callers to bump up to 450 baud
  23. '  CheckRatio    20096  Test upload/download ratio
  24. '  CheckMacro     1242  Checks for macro and processes
  25. '  CopyRight        97  Display RBBS-PC's copyright notice
  26. '  DEFALTU        9600  Write out the user's defaults
  27. '  DenyAccess     1386  Downgrade security so access denied
  28. '  DoorExit      10983  Set up a .BAT file to exit RBBS-PC to a "door"
  29. '  DosExit       10934  Set up a .BAT file to exit to DOS (second level)
  30. '  EditALine      2618  Edits a single line
  31. '  EditDef         120  Edit configuration parameters
  32. '  FileNameCheck 20240  Matches file name to a prefix & extension
  33. '  GetArc        20140  Handle request for verbose listing
  34. '  GetCommand      101  Get RBBS-PC's node id from command line
  35. '  GetTime        9140  Calculates callers elapsed time (hh,mm,ss)
  36. '  GoIdle           90  Release resources when waiting for keyboard input
  37. '  KillMsg        3952  Delete old or unnecessary messages
  38. '  Line25          945  Build and/or update line 25 of RBBS-PC's local screen
  39. '  LineEdit       3700  Edit a line while minimizing string space consumption
  40. '  LogError      13660  Log error message to CALLERS file
  41. '  LPrnt          1480  Subroutine to write to local display
  42. '  MLInit            8  Handle MultiLink initialization/de-initialization
  43. '  MsgProt        2055  Sets protection for a message
  44. '  MessageTo      2018  Sets who a message is to
  45. '  PageLen        5200  Change page length
  46. '  ParseIt        1637  Parses a string
  47. '  PassWrd         660  Verify user & message passwords
  48. '  PopCmdStack    1650  Get user input, 1st checking command stack
  49. '  PScrn          1483  Print to display
  50. '  QuickLPrnt     1482  Quickly writes count of blocks on file transfer
  51. '  QuickTPut      1478  Fast, but limited, "TPut" equivalent
  52. '  QuickTPut1     1478  Outputs short string following by CR LF
  53. '  RBBSExit      10992  RBBS-PC exit to transfer control to other programs
  54. '  RecoverMsg    10410  Recover a deleted message
  55. '  RemNonAlf      5100  Removes non-alpha characters from a string
  56. '  RingCaller     1636  Ring caller's bell and put message in emphasis
  57. '  SetBaud        1654  Set baud rate in the 8250 chip of the RS232 interface
  58. '  SetCrLf        1496  Set up the necessary carriage return/line feed string
  59. '  SetSection    12000  Set the proper section prompts (main, file, util, libr)
  60. '  SetThread      4554  Set up request for threading thru messages
  61. '  SkipLine       1485  Write a # of blank lines to the communications port
  62. '  SearchCmd      1238  Searches list of commands in RBBS for a request
  63. '  SecViolation   1380  Process a security violation
  64. '  SysMenu         112  Displays sysop menu/status
  65. '  SysopChat      4773  Sysop and caller chat
  66. '  TestRel         336  Tests for Reliable connect
  67. '  TGet           1498  Read a line from the communications port
  68. '  TPut           1396  Write a line to the communications port
  69. '  Trim            105  Strip leading and trailing blanks from a string
  70. '  TrimTrail       107  Strip off specified string off end of another string
  71. '  UntilRight    12878  Ask a question until user says answer is right
  72. '  UpdateU       10600  Updates the user record on loging off/exiting RBBS-PC
  73. '  VarInit         109  Initialize system variables
  74. '  ViewHelp       1330  Processes help command
  75. '  WhoCheck       2250  Checks whether a user exists in user file
  76. '  WhosOn         9801  Report status of each node - who's on
  77. '  WordInFile    10976  Find a whole word within a file/menu
  78. '
  79. '  $INCLUDE: 'RBBS-VAR.BAS'
  80. '
  81. 8 '  $SUBTITLE: 'MLInit - MultiLink initialization/deinitialization'
  82. '  $PAGE
  83. '
  84. '  NAME    -- MLInit
  85. '
  86. '  INPUTS  --  MLParm = 1             INITIALIZE AT STARTUP OR RE-
  87. '                                     CYLCE TIME
  88. '              MLParm = 2             DE-INITIALIZE ON EXITING TO
  89. '                                     A DOOR OR DOS REMOTELY
  90. '              MLParm = 3             DE-QUEUE COMMUNICATIONS PORTS
  91. '              MLParm = 4             CHECK FOR MULTILINK PRESENT
  92. '              ZDoorsTermType
  93. '              ZBaudTest!
  94. '              ZComPort$
  95. '              ZComputerType
  96. '
  97. '  OUTPUTS --  NONE
  98. '
  99. '  PURPOSE --  To test for the presence of multi-link and set
  100. '              multi link options to be compatible with RBBS-PC
  101. '
  102.       SUB MLInit (MLParm) STATIC
  103.     DEF SEG = 0
  104.     IF ZComputerType = 1 _
  105.        GOTO 10
  106.     IF NOT ZMLCom THEN _
  107.        IF ZNetworkType <> 1 THEN _
  108.           GOTO 10
  109.     ZMultiLinkPresent = PEEK(&H1FE) + 256 * PEEK(&H1FF)
  110.     IF ZMultiLinkPresent = 0 THEN _
  111.        GOTO 10
  112.     ON MLParm GOSUB 30,20,60,10
  113. 10  DEF SEG
  114.     EXIT SUB
  115. 20  IF ZDoorsTermType < 1 THEN _
  116.        RETURN
  117.     DEF SEG = ZMultiLinkPresent
  118.     GOSUB 60
  119. ' **************     MLUTIL BAUD n (where n = ZBaudTest!)  ******
  120.     WasAX = &H600
  121.     WasBX = ZBaudTest!   ' Tell ML the baud rate
  122.     GOSUB 80
  123. ' **************     MLUTIL TERM n (where n = ZDoorsTermType) ****
  124.     WasAX = &H700 + ZDoorsTermType
  125.     GOSUB 80         ' Tell ML the terminal type
  126. ' *********          MLINK /port       ***********
  127. '                    ' Tell ML the communications port
  128.     POKE (&H64 + PEEK(&H58) + 256 * PEEK(&H59) + &HC),ASC(RIGHT$(ZComPort$,1)) - 48
  129. ' ************       MLUTIL SCMON       *************
  130.     WasAX = &HB01
  131.     WasBX = 0           ' Tell ML to start monitoring the carrier
  132.     GOSUB 80
  133.     RETURN
  134. ' **************     MLUTIL CCMON       ***************
  135. 30  WasAX = &HB00       ' Turn off ML's carrier monitoring.
  136.     WasBX = 0
  137.     GOSUB 80
  138. ' **************     MLUTIL TERM 1       *************
  139.     WasAX = &H701       ' Change terminal type to ML type 1.
  140.     WasBX = 0
  141.     GOSUB 80
  142. ' *******  MLINK /port (where port = 9 if ML 3.03 or earlier  ******
  143. ' *******            port = 0 if ML 4.00 or greater           ******
  144.     DEF SEG = ZMultiLinkPresent
  145.     MultiLinkCommPort = (&H64 + PEEK(&H58) + 256 * PEEK(&H59) + &HC)
  146.     MultiLinkVersion = PEEK(&H1) + 256 * PEEK(&H2)
  147.     IF PEEK(MultiLinkCommPort) = &H1 OR _
  148.        PEEK(MultiLinkCommPort) = &H2 THEN _
  149.        IF MultiLinkVersion > 5000 THEN _
  150.           POKE (MultiLinkCommPort),&H0 _
  151.        ELSE POKE (MultiLinkCommPort),&H9
  152. ' **********         MLUTIL ENQ         **********
  153.     WasAX = &H1        ' Tell ML to conditional enque on the comm. port
  154.     GOSUB 70
  155. ' **********         MLUTIL BAUD 19200      *********
  156.     WasAX = &H600       ' Tell ML to reset the buad rate (19200 BAUD)
  157.     WasBX = 19200
  158.     GOSUB 80
  159.     RETURN
  160. ' **********         MLUTIL DEQ         *********
  161. 60 WasAX = &H100        ' Tell ML to unconditionally deque the comm. port
  162. 70 WasBX = -4
  163.    IF ZComPort$ = "COM2" THEN _
  164.       WasBX = -3
  165.    IF ZComPort$ = "COM0" THEN _
  166.       RETURN
  167. ' ******  MULTI-LINK PROGRAMMING SUPPORT INTERFACE  *******
  168. 80 CALL RBBSML(WasAX,WasBX)
  169.    RETURN
  170.    END SUB
  171. 90 '  $SUBTITLE: 'GoIdle - release control when waiting'
  172. '  $PAGE
  173. '
  174. '  NAME    -- GoIdle
  175. '
  176. '  INPUTS  -- ZMLCom
  177. '             ZNetworkType
  178. '
  179. '  OUTPUTS --  NONE
  180. '
  181. '  PURPOSE --  To relinquish control when RBBS-PC is waiting for
  182. '              input from the communications port
  183. '
  184.       SUB GoIdle STATIC
  185.    IF ZMLCom OR ZNetworkType = 1 THEN _
  186.       CALL MLInit(5) : _
  187.       EXIT SUB
  188.    CALL GiveBack
  189.    END SUB
  190. 97 '  $SUBTITLE: 'CopyRight - subroutine to display RBBS-PC copyright'
  191. '  $PAGE
  192. '
  193. '  NAME    -- CopyRight
  194. '
  195. '  INPUTS  --  NONE
  196. '
  197. '  OUTPUTS --  NONE
  198. '
  199. '  PURPOSE --  To display RBBS-PC's copyright notice on the local screen
  200. '
  201.       SUB CopyRight STATIC
  202.    ZWasA = (ZRecycleToDos OR ZDebug OR ZNodeRecIndex > 2)
  203.    IF ZWasA THEN _
  204.       EXIT SUB
  205.    WIDTH 80
  206.    REDIM ZOutTxt$(11)
  207.    ZOutTxt$(1) = "If you use RBBS-PC CPC17.3, please consider contributing to"
  208.    ZOutTxt$(2) = ""
  209.    ZOutTxt$(3) = "             Capital PC Software Exchange"
  210.    ZOutTxt$(4) = "                 Post Office Box 6128"
  211.    ZOutTxt$(5) = "            Silver Spring, Maryland  20906"
  212.    ZOutTxt$(6) = ""
  213.    ZOutTxt$(7) = "You are free to copy and share RBBS-PC CPC17.3 provided"
  214.    ZOutTxt$(08)= "  1.  This program is distributed unmodified"
  215.    ZOutTxt$(09)= "  2.  No fee or consideration is charged for RBBS-PC itself"
  216.    ZOutTxt$(10)= "  3.  This notice is not bypassed or removed."
  217.    CLS
  218.    KEY OFF
  219.    LOCATE ,,0
  220.    ZSnoop = -1
  221.    ZLocalUser = -1
  222.    CALL LPrnt(SPACE$(60) + "tm",1)
  223.    CALL LPrnt(SPACE$(16) + STRING$(15,205) + " U S E R W A R E " + STRING$(15,205),1)
  224.    CALL SkipLine(1)
  225.    CALL LPrnt(SPACE$(17) + "Capital PC User Group User-Supported Software",1)
  226.    CALL SkipLine (1)
  227.    CALL LPrnt(SPACE$(5) + CHR$(214) + STRING$(66,196) + CHR$(183),1)
  228.    FOR WasI = 1 TO 10
  229.       CALL LPrnt(SPACE$(5) + CHR$(186) + "    " + ZOutTxt$(WasI) + SPACE$(62 - LEN(ZOutTxt$(WasI))) + CHR$(186),1)
  230.    NEXT
  231.    CALL LPrnt(SPACE$(5) + CHR$(211) + STRING$(66,196) + CHR$(189),1)
  232.    CALL LPrnt(SPACE$(5) + "Copyright (c) 1983-90 Tom Mack, 39 Cranbury Drive, Trumbull, CT 06611",1)
  233.    CALL DelayTime (1)
  234.    ZSnoop = 0
  235.    END SUB
  236. 101 ' $SUBTITLE: 'GetCommand - sub to get command from command line'
  237. ' $PAGE
  238. '
  239. '  NAME    -- GetCommand
  240. '
  241. '  INPUTS  --     PARAMETER                    MEANING
  242. '             ZConfigFileName$     NAME OF RBBS-PC ".DEF" FILE TO
  243. '                                  USE AS A MODEL WHEN CREATING THE
  244. '                                  .DEF FILE NAME TO BE USED BY THIS
  245. '                                  COPY OF RBBS-PC.
  246. '
  247. '             COMMAND LINE         COMMAND LINE USED TO INVOKE
  248. '                                  RBBS-PC IN THE FORM:
  249. '
  250. '       RBBS-PC.EXE x filename DEBUG /time /baud /reliable
  251. '
  252. '   WHERE THE OPTIONAL PARAMETERS ARE:
  253. '
  254. '  x       IS THE NODE ID IN THE RANGE 1-9,0,A-Z
  255. ' filename IS THE FULLY QUALIFIED FILE NAME TO USE AS THE ".DEF" FILE
  256. ' DEBUG    IS A DEBUGGING Switch
  257. ' /time    IS THE TIME OF DAY FOR RBBS-PC TO RETURN TO THE CALLER
  258. ' /baud    IS THE BAUD RATE OF THE CALLER IF RBBS-PC IS BEING SHELLED TO BY
  259. '             ANOTHER COMMUNICATIONS PROGRAM (THE COMMUNICATIONS PORT BEING
  260. '             USED IS ASSUMED TO BE THE ONE INPUTTED VIA THE RBBS-PC CONFIG
  261. '             PROGRAM
  262. ' /reliable IS IF RELIABLE MODE WAS DETECTED BY A HOST MAILER
  263. '
  264. ' IF NO PARAMETERS ARE SUPPLIED, RBBS-PC ASSUMES THAT THE .DEF FILE NAME IS
  265. ' RBBS-PC.DEF AND THAT THE NODE IS NODE 1.
  266. '
  267. '  OUTPUTS -- ZConfigFileName$     NAME OF RBBS-PC ".DEF" FILE FOR
  268. '                                  THIS COPY OF RBBS-PC TO USE
  269. '             ZNodeRecIndex    RECORD NUMBER WITHIN THE
  270. '                                  MESSAGES FILE FOR THIS "NODE"
  271. '                                  (RANGE IS 2 TO 36)
  272. '
  273. '  PURPOSE --  To get node id from command line and determine if rbbs
  274. '              is being run as a door
  275. '
  276.       SUB GetCommand (PassedDebug,NetTime$,ZNetBaud$,ZNetReliable$) STATIC
  277.       STATIC ZDebug
  278. '
  279. '
  280. ' *  GET NODE ID FROM COMMAND LINE
  281. '
  282. '
  283.       WasPM$ = COMMAND$
  284.       CALL AllCaps(WasPM$)
  285.       IF INSTR(WasPM$,"/") = 0 THEN _
  286.          GOTO 103
  287. '
  288. '
  289. ' * PARSE THE COMMAND LINE FOR THREE POSITIONAL SWITCHES FOR NET MAIL
  290. '
  291. '
  292.       CmdLine$ = MID$(WasPM$,INSTR(WasPM$,"/"))
  293.       WasPM$ = LEFT$(WasPM$,INSTR(WasPM$,"/") - 1)
  294.       ZWasA = 0
  295.       FOR WasX = 1 TO LEN(CmdLine$)
  296.           IF MID$(CmdLine$,WasX,1) = "/" THEN _
  297.              ZWasA = ZWasA + 1 : _
  298.              ZSubDir$(ZWasA) = "" _
  299.           ELSE ZSubDir$(ZWasA) = ZSubDir$(ZWasA) + MID$(CmdLine$,WasX,1)
  300.       NEXT
  301.       NetTime$ = ZSubDir$(1)
  302.       IF ZWasA > 1 THEN _
  303.          ZNetBaud$ = ZSubDir$(2)
  304.       IF ZWasA > 2 THEN _
  305.          ZNetReliable$ = ZSubDir$(3)
  306.       CALL Trim(NetTime$)
  307.       CALL Trim(ZNetBaud$)
  308.       CALL Trim(ZNetReliable$)
  309. 103   ZWasA = INSTR(WasPM$,"DEBUG")
  310.       IF ZWasA > 0 THEN _
  311.          ZDebug = -1 : _
  312.          WasPM$ = LEFT$(WasPM$,ZWasA - 1) + _
  313.                RIGHT$(WasPM$,LEN(WasPM$) - ZWasA - 4)
  314.       PassedDebug = ZDebug
  315.       ZWasA = INSTR(WasPM$,"LOCAL")
  316.       IF ZWasA > 0 THEN _
  317.          ZComPort$ = "COM0" : _
  318.          WasPM$ = LEFT$(WasPM$,ZWasA - 1) + _
  319.                RIGHT$(WasPM$,LEN(WasPM$) - ZWasA - 4)
  320.       IF LEN(WasPM$) = 0 THEN _
  321.          WasPM$ = "-"
  322.       ZNodeRecIndex = INSTR("-1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ",LEFT$(WasPM$,1))
  323.       IF ZNodeRecIndex < 2 THEN _
  324.          ZNodeRecIndex = 2
  325.       ZNodeID$ = MID$(STR$(ZNodeRecIndex-1),2)
  326.       IF ZNodeRecIndex > 10 THEN _
  327.          ZNodeFileID$ = LEFT$(WasPM$,1) _
  328.       ELSE ZNodeFileID$ = ZNodeID$
  329.       IF ZNodeID$ <> "1" THEN _
  330.          ZLibNodeID$ = ZNodeFileID$
  331.       IF LEN(WasPM$) > 2 AND MID$(WasPM$,2,1) = " " THEN _
  332.          ZConfigFileName$ = MID$(WasPM$,3)_
  333.       ELSE MID$(ZConfigFileName$,5,1) = WasPM$
  334.       ZOrigCnfg$ = ZConfigFileName$
  335.       END SUB
  336. 105 ' $SUBTITLE: 'Trim - sub to eliminate leading/trailing blanks'
  337. ' $PAGE
  338. '
  339. '  NAME    -- Trim
  340. '
  341. '  INPUTS  --  PARAMETER                    MEANING
  342. '              TrimParm$           STRING THAT IS TO HAVE LEADING
  343. '                                  AND TRAILING BLANKS ELIMINATED FROM
  344. '
  345. '  OUTPUTS --  TrimParm$           STRING WITH NO LEADING OR TRAILING
  346. '                                   BLANKS
  347. '
  348. '  PURPOSE --  To strip leading and trailing blanks
  349. '
  350.       SUB Trim (TrimParm$) STATIC
  351.       WasL = INSTR(TrimParm$," ")
  352.       IF WasL < 1 THEN _
  353.          EXIT SUB
  354.       IF WasL = 1 THEN _
  355.          WHILE LEFT$(TrimParm$,1) = " " : _
  356.             TrimParm$ = RIGHT$(TrimParm$,LEN(TrimParm$) - 1) : _
  357.          WEND
  358.       CALL TrimTrail (TrimParm$," ")
  359.       END SUB
  360. '
  361. 107 '  $SUBTITLE: 'TrimTrail - sub to trim off trailing characters'
  362. '  $PAGE
  363. '
  364. '  NAME    --  TrimTrail
  365. '
  366. '  INPUTS  --  PARAMETER           MEANING
  367. '              TrimParm$  WHAT STRING TO Trim FROM
  368. '              TrimThis$  WHAT CHARACTER TO Trim OFF END
  369. '
  370. '  OUTPUTS --  NONE
  371. '
  372. '  PURPOSE --  To remove all occurences of a character from end of string
  373. '
  374.       SUB TrimTrail (TrimParm$,TrimThis$) STATIC
  375.       IF RIGHT$(TrimParm$, 1) <> TrimThis$ THEN _
  376.          EXIT SUB
  377.       WasJ = LEN(TrimParm$) - 1
  378. 108   IF WasJ > 0 THEN _
  379.          IF MID$(TrimParm$, WasJ, 1) = TrimThis$ THEN _
  380.             WasJ = WasJ - 1 : _
  381.             GOTO 108
  382.       TrimParm$ = LEFT$(TrimParm$, WasJ)
  383.       END SUB
  384. '
  385. 109 '  $SUBTITLE: 'VarInit - subroutine to initialize system variables'
  386. '  $PAGE
  387. '
  388. '  NAME    --  VarInit
  389. '
  390. '  INPUTS  --  PARAMETER           MEANING
  391. '              NONE
  392. '
  393. '  OUTPUTS --  NONE
  394. '
  395. '  PURPOSE --  To initialize system variable
  396. '
  397.       SUB VarInit STATIC
  398.     ZAcknowledge$ = CHR$(6)
  399.     ZAckChar$ = "C" + _
  400.             ZAcknowledge$
  401.     ZActiveMenu$ = "B"
  402.     ZActiveMessage$ = CHR$(225)
  403.     ZBackSpace$ = CHR$(8) + _
  404.                  CHR$(32) + _
  405.                  CHR$(8)
  406.     ZBackArrow$ = CHR$(29) + _
  407.                   CHR$(32) + _
  408.                   CHR$(29)
  409.     ZBaudRates$ = "      300  450 1200 2400 4800 96001920038400"
  410.     ZBellRinger$ = CHR$(7)
  411.     ZBulletinMenu$ = ""
  412.     ZWasCL = 24
  413.     ZCancel$ = CHR$(24)
  414.     ZColorReset$ = CHR$(27) + _
  415.                    "[00;37;40m"
  416.     ZConfigFileName$ = "RBBS-PC.DEF"
  417.     ZCarriageReturn$ = CHR$(13)
  418.     ZDeletedMsg$ = CHR$(226)
  419.     ZDosVersion = 2
  420.     ZEndTransmission$ = CHR$(4)
  421.     ZEscape$ = CHR$(27)
  422.     ZExpectActiveModem = 0
  423.     ZFalse = 0
  424.     ZF1Key = 59
  425.     ZF10Key = 68
  426.     ZConfName$ = "MAIN"
  427.     CALL SetHiLite (ZTrue)
  428.     ZHomeConf$ = ""
  429.     ZInConfMenu = -1
  430.     ZLastCommand$ = "M "
  431.     ZLimitMinsPerSession = 0
  432.     ZLineFeed$ = CHR$(10)
  433.     ZLineFeeds = NOT ZFalse
  434.     ZLineEditChk$ = CHR$(9) + _
  435.                     ZLineFeed$ + _
  436.                     CHR$(11) + _
  437.                     CHR$(12) + _
  438.                     CHR$(127) + _
  439.                     CHR$(8) + _
  440.                     ZBellRinger$ + _
  441.                     CHR$(26) + _
  442.                     CHR$(227)
  443.     ZLineMes$ = SPACE$(78)          ' fixed length string workspace
  444.     ZLockStatus$ = "UM UU UB UD"
  445.     ZMenuIndex = 2
  446.     ZNAK$ = CHR$(21)
  447.     ZNoAdvance = ZFalse
  448.     ZPageLength = 23
  449.     ZParseOff = ZFalse
  450.     ZPressEnter$ = " ([RETURN] to quit)"  ' Bh
  451.     ZPressEnterExpert$ = " ([RETURN] to quit)"  ' Bh
  452.     ZPressEnterNovice$ = ZPressEnter$
  453.     ZPrivateDoor = ZFalse
  454.     ZRightMargin = 72
  455.     ZReturnLineFeed$ = ZCarriageReturn$ + _
  456.                         ZLineFeed$
  457.     ZSmartTable$ = "CS PB NS FN LN SL DT TM TR TE TL RP RR CT " + _
  458.                    "C1 C2 C3 C4 C0 DD BD DB UB DL UL FI VY VN " + _
  459.                    "TY TN BN ND FS LS BA                             ' DGS-STA
  460.     ZStartOfHeader$ = CHR$(1)
  461.     ZTimeLoggedOn$ = SPACE$(8)
  462.     ZTrue = NOT ZFalse
  463.     ZUpInc = -1
  464.     ZXOff$ = CHR$(19)
  465.     ZXOn$ = CHR$(17)
  466.     ZInterrupOn$ = CHR$(11) + ZCancel$ + ZXOff$ + ZXOn$ + ZCarriageReturn$
  467.     ZOptionEnd$ = ZReturnLineFeed$ + " ,("
  468.     ZCrLf$ = ZCarriageReturn$ + ZLineFeed$
  469.     ZWasLG$(1) = "Registration Check Failed"
  470.     ZWasLG$(2) = "Sysop name attempted"
  471.     ZWasLG$(3) = "Locked out attempt"
  472.     ZWasLG$(4) = "Password Attempt Failed"
  473.     ZWasLG$(5) = "Auto Lockout done"
  474.     ZWasLG$(6) = "Name in use on another Node!"
  475.     ZWasLG$(7) = ""
  476.     ZWasLG$(8) = "Locked reason read!"
  477.     ZWasLG$(9) = "Expired Registration"
  478.     END SUB
  479. '
  480. 112 ' $SUBTITLE: 'SysMenu - sub to display RBBS-PC SYSOP menu'
  481. '  $PAGE
  482. '
  483. '  NAME    --  SysMenu
  484. '
  485. '  INPUTS  --  PARAMETER           MEANING
  486. '
  487. '  OUTPUTS --  NONE
  488. '
  489. '  PURPOSE --  TO DISPLAY RBBS-PC's SYSOP MENU ON THE LOCAL SCREEN
  490. '
  491.     SUB SysMenu STATIC
  492.     ZLocalUser = ZTrue
  493.     ZSnoop = ZTrue
  494.     ZNonStop = ZTrue
  495.     CALL CheckTime (TIMER, ZDelay!, 1)
  496.     CLS
  497.     ZStopInterrupts = ZTrue
  498.     ZBypassTimeCheck = ZTrue
  499.     CALL BufFile ("MENU0",WasX)
  500.     ZNonStop = ZFalse
  501.     ZBypassTimeCheck = ZFalse
  502.     ZLocalUser = ZFalse
  503.     IF NOT ZOK THEN _
  504.        CALL LPrnt("MENU0 not on default drive",1)
  505.     LOCATE 2,18
  506.     CALL LPrnt(LEFT$(ZVersionID$,8),0)
  507.     LOCATE 2,42
  508.     CALL LPrnt(ZNodeID$,0)
  509.     LOCATE 2,60
  510.     WasX$ = DATE$
  511.     CALL LPrnt(LEFT$(WasX$,6) + RIGHT$(WasX$,2),0)
  512.     LOCATE 2,74
  513.     CALL LPrnt(LEFT$(TIME$,5),0)
  514.     IF ZFMSDirectory$ <> "" THEN _
  515.        LOCATE 6,76 : _
  516.        CALL LPrnt("YES",0)
  517.     IF ZExtendedLogging THEN _
  518.        LOCATE 8,76 : _
  519.        CALL LPrnt("YES",0)
  520.     IF ZFossil THEN _
  521.        LOCATE 10,76 : _
  522.        CALL LPrnt("YES",0)
  523.     LOCATE 12,75 : _
  524.     CALL LPrnt(ZComPort$,0)
  525.     LOCATE 14,75
  526.     CALL LPrnt (STR$(CINT(FRE("A")/1024)) + "k",0)
  527.     IF ZDebug THEN _
  528.        LOCATE 22,76 : _
  529.        CALL LPrnt("Yes",0)
  530.     END SUB
  531. '
  532. 120 '  $SUBTITLE: 'EditDef - sub to edit config parameters'
  533. '  $PAGE
  534. '
  535. '  NAME    -- EditDef
  536. '
  537. '  INPUTS  --     PARAMETER                    MEANING
  538. '
  539. '  OUTPUTS --                          OUTPUT STRING
  540. '
  541. '  PURPOSE -- Interpretes and adjusts stored configuration parameters
  542. '
  543.       SUB EditDef STATIC
  544.       ZAllOpts$ = ZMainCmds$ + _
  545.                   ZFileCmd$ + _
  546.                   ZUtilCmds$ + _
  547.                   ZLibCmds$ + _
  548.                   ZGlobalCmnds$ + _
  549.                   ZSysopCmds$
  550.       ZHelpExtension$ = "." + _
  551.                         ZHelpExtension$
  552.       ZCompressedExt$ = ZDefaultExtension$
  553.       ZWasQ = INSTR(ZDefaultExtension$,".")
  554.       IF ZWasQ > 0 THEN _
  555.          ZDefaultExtension$ = LEFT$(ZDefaultExtension$, ZWasQ-1)
  556.       ZCurDirPath$ = ZDirPath$
  557.       ZBegMain = 1
  558.       ZBegFile = LEN(ZMainCmds$) + ZBegMain
  559.       ZBegUtil = LEN(ZFileCmd$) + ZBegFile
  560.       ZBegLibrary = LEN(ZUtilCmds$) + ZBegUtil
  561.       ZHelp$(3) = ZHelpPath$ + _
  562.                  ZHelp$(3)
  563.       ZHelp$(4) = ZHelpPath$ + _
  564.                  ZHelp$(4)
  565.       ZHelp$(7) = ZHelpPath$ + _
  566.                  ZHelp$(7)
  567.       ZHelp$(9) = ZHelpPath$ + _
  568.                  ZHelp$(9)
  569.       CALL BreakFileName (ZWelcomeFile$,ZWelcomeFileDrvPath$,Prefix$,_
  570.                      Extension$,ZTrue)
  571.      CALL ASCIICodes ("[","]",ZDefaultLineACK$)
  572.      CALL ASCIICodes ("[","]",ZHostEchoOn$)
  573.      CALL ASCIICodes ("[","]",ZHostEchoOff$)
  574.      CALL ASCIICodes ("[","]",ZEmphasizeOffDef$)
  575.      CALL ASCIICodes ("[","]",ZEmphasizeOnDef$)
  576.      ZDR1$ = ZFG1Def$
  577.      ZDR2$ = ZFG2Def$
  578.      ZDR3$ = ZFG3Def$
  579.      ZDR4$ = ZFG4Def$
  580.      IF ZSubParm = -62 THEN _
  581.         EXIT SUB
  582.      ZLocalUserMode = (RIGHT$(ZComPort$,1) < "1")
  583.      IF ZLocalUserMode THEN _
  584.         ZRecycleToDos = ZTrue
  585.      ZEchoer$ = ZDefaultEchoer$
  586.      IF LEN(ZScreenOutMsg$) < 2 THEN _
  587.         ZScreenOutMsg$ = ZStartOfHeader$
  588.      ZSmartTextCode$ = CHR$(ZSmartTextCode)
  589.      IF ZMaxWorkVar < 13 THEN _
  590.         ZMaxWorkVar = 13
  591. '
  592. ' ***  ESTABLISH RBBS-PC'S DOS SUBDIRECTORIES USAGE  ***
  593. '
  594.     IF ZMainFMSDir$ <> "" THEN _
  595.        ZFMSDirectory$ = ZDirPath$ + _
  596.                         ZMainFMSDir$ + _
  597.                         "." + _
  598.                         ZMainDirExtension$ : _
  599.        ZActiveFMSDir$ = ZFMSDirectory$ : _
  600.        ZLibDir$ = ZLibDirPath$ + _
  601.                             ZMainFMSDir$ + _
  602.                             "." + _
  603.                             ZLibDirExtension$
  604.     ZUpcatHelp$ = ZHelpPath$ + _
  605.                   ZUpcatHelp$ + _
  606.                   ZHelpExtension$
  607.     IF ZSubDirCount < 1 THEN _
  608.        GOTO 123
  609.     FOR ZSubDirIndex = 1 TO ZSubDirCount
  610.        INPUT #2,ZSubDir$
  611.        IF RIGHT$(ZSubDir$,1) <> "\" THEN _
  612.          ZSubDir$(ZSubDirIndex) = ZSubDir$ + _
  613.                                  "\" _
  614.        ELSE ZSubDir$(ZSubDirIndex) = ZSubDir$
  615.     NEXT
  616.     GOTO 125
  617. 123 FOR ZSubDirIndex = 1 TO LEN(ZDnldDrives$) - 1
  618.        ZSubDir$(ZSubDirIndex) = MID$(ZDnldDrives$,ZSubDirIndex,1) + _
  619.                                ":"
  620.     NEXT
  621.     ZSubDirCount = LEN(ZDnldDrives$) - 1
  622. '
  623. ' *****  SETUP UPLOAD DRIVE AND DIRECTORY.NAME  ***
  624. '
  625. 125 ZUpldDirCheck$ = ZUpldDir$
  626.     ZSubDirCount = ZSubDirCount + 1
  627.     IF ZUpldToSubdir THEN _
  628.        ZSubDir$(ZSubDirCount) = ZUpldSubdir$ + _
  629.                                "\" _
  630.     ELSE ZSubDir$(ZSubDirCount) = RIGHT$(ZDnldDrives$,1) + _
  631.                                  ":"
  632.     ZUpldDir$ = ZUpldDir$ + _
  633.                         "." + _
  634.                         ZMainDirExtension$
  635.     CALL SearchArray (ZSubDir$(ZSubDirCount),ZSubDir$(),ZSubDirCount-1,Found)
  636.     ZCanDnldFromUp = (Found > 0)
  637.     ZUpldDir$ = ZUpldPath$ + _
  638.                         ZUpldDir$
  639. 126 CLOSE #2
  640.     IF ZLibDrive$ <> "" THEN _
  641.        ZLibType = 1
  642.     ZSubParm = -10
  643.     CALL Carrier
  644.     IF ZSubParm = -1 THEN _
  645.        IF ZLibDrive$ <> "" THEN _
  646.           CALL ChangeDir (ZLibDrive$ + _
  647.                          "\") : _
  648.           CALL KillWork (ZLibWorkDiskPath$ + _
  649.                         ZLibNodeID$ + _
  650.                         "DK*.ARC") : _
  651.                         ZErrCode = 0
  652. '
  653. ' ***  INITIALIZE OMNINET INTERFACE IF OMNINET IN USE  ***
  654. '
  655. 128 IF ZNetworkType = 2 THEN _
  656.        ZWasCN$ = SPACE$(535) : _
  657.        CALL InitIO(ZWasA)
  658.        END SUB
  659. '
  660. 129 '  $SUBTITLE: 'ASCIICodes - subrotuine to allow any ASCII codes'
  661. '  $PAGE
  662. '
  663. '  NAME    -- ASCIICodes
  664. '
  665. '  INPUTS  --     PARAMETER                    MEANING
  666. '                 LeftParen$           MARKS BEGINNING OF #
  667. '                 RightParen$          MARKS END OF #
  668. '                 Strng$                INPUT STRING
  669. '
  670. '  OUTPUTS --    Strng$                OUTPUT STRING
  671. '
  672. '  PURPOSE -- To allow a config string to have any ascii values.
  673. '             characters not enclosed taken as is.  Enclosed
  674. '             characters interpreted as value of ascii code.
  675. '             (e.g. "123[32]4" is interpreted as "123 4").
  676. '
  677.     SUB ASCIICodes (LeftParen$,RightParen$,Strng$) STATIC
  678.     IF LEN(Strng$) < 1 THEN _
  679.        EXIT SUB
  680.     Start = 1
  681.     WasL = LEN(Strng$)
  682.     ZUserIn$ = Strng$ + _
  683.          LeftParen$
  684.     WasX = INSTR(ZUserIn$,LeftParen$)
  685.     NewString$ = ""
  686.     WHILE Start <= WasL
  687.        NewString$ = NewString$ + _
  688.                     MID$(ZUserIn$,Start,WasX - Start)
  689.        WasY = INSTR(WasX,ZUserIn$,RightParen$)
  690.        IF WasY > 0 THEN _
  691.           WasK = VAL(MID$(ZUserIn$,WasX + 1,WasY - WasX - 1)) : _
  692.           NewString$ = NewString$ + _
  693.                        CHR$(WasK) : _
  694.           Start = WasY + 1 _
  695.        ELSE NewString$ = NewString$ + _
  696.                          MID$(ZUserIn$,WasX,WasL + 1 - WasX) : _
  697.             Start = WasL + 1
  698.        WasX = INSTR(Start,ZUserIn$,LeftParen$)
  699.     WEND
  700.     Strng$ = NewString$
  701.     END SUB
  702. 200 ' $SUBTITLE: 'AnswerIt - sub to establish connection'
  703. ' $PAGE
  704. '
  705. '  NAME    -- AnswerIt
  706. '
  707. '  INPUTS  --     PARAMETER                    MEANING
  708. '                 ZSubParm = 1           WAIT FOR PHONE TO RING
  709. '                          = 2           CONTINUE LOOKING FOR CONNECT
  710. '                          = 3           RENTRY AFTER FUNCTION KEY
  711. '                          = 4           GO ON LINE IMMEDIATELY
  712. '                 ZBG                    LOCAL DISPLAY'S BACKGROUND
  713. '                 ZBorder                LOCAL DISPLAY'S BORDER COLOR
  714. '                 ZComPort$              COMMUNICATIONS PORT NAME
  715. '                 ZComputerType          TYPE OF COMPUTER RUNNING ON
  716. '                 ZDumbModem             NON-HAYES TYPE MODEM FLAG
  717. '                 ZExtendedLogging       EXTENDED CALLERS LOG FLAG
  718. '                 ZFG                    LOCAL DISPLAY'S FOREGROUND
  719. '                 ZModemAnswerCmd$       COMMAND TO ANSWER PHONE
  720. '                 ZModemCntlReg          LOCATION WasOF MODEM CNTRL. REG
  721. '                 ZModemCountRingsCmd$   COMMAND TO COUNT PHONE RINGS
  722. '                 ZModemInitBaud$        BAUD AT WHICH TO OPEN COMM.
  723. '                 ZModemResetCmd$        COMMAND TO RESET THE MODEM
  724. '                 ZModemStatusReg        LOCATION OF MODEM STATUS REG
  725. '                 ZPrinter               FLAG TO PRINT ON LOCAL PRT.
  726. '                 ZRequiredRings         NUMBER OF RINGS TO ANSWER ON
  727. '                 ZSnoop                 FLAG TO DISPLAY ON LOCAL PC
  728. '                 ZSysopNext             FLAG TO GIVE SYSOP CONTROL
  729. '
  730. '  OUTPUTSS --    BaudTest!              BAUD RATE TO SET RS232 AT
  731. '                 ZEightBit              PARITY INDICATOR
  732. '                 ZReliableMode          INDICATES MODEM-SUPPLIED
  733. '                                        "ERROR-FREE" Protocol ACTIVE
  734. '                 ZSubParm          = 1  Carrier DETECT Found (I.E.
  735. '                                        MODEM AUTO-ANSWERED).
  736. '                                   = 2  ANSWERED THE PHONE AND
  737. '                                        Carrier DETECT OCCURRED.
  738. '                                   = 3  SYSOP HIT "ESC" KEY ON THE
  739. '                                        LOCAL KEYBOARD.
  740. '                                   = 4  ANSWERED THE PHONE BUT NO
  741. '                                        Carrier WAS DETECTED.
  742. '                                   = 5  COMM. BUFFER OVERFLOW.
  743. '                                   = 6  FUNCTION KEY PRESSED ON THE
  744. '                                        LOCAL KEYBOARD.
  745. '
  746. '  PURPOSE -- To detect incoming call and establish connection.
  747. '
  748.       SUB AnswerIt STATIC
  749.       ZErrCode = 0
  750.       ZReliableMode = ZFalse
  751.       ZFF = ZSubParm
  752.       ZSubParm = 0
  753.       ON ZFF GOTO 201,324,245,320
  754. '
  755. '
  756. ' *  INITIALIZE MODEM AND ANNOUNCE RBBS-PC IS UP AND READY FOR CALLS
  757. '
  758. '
  759. 201 ZSubParm = -10
  760.     CALL Carrier
  761.     IF ZSubParm = 0 THEN _
  762.        GOTO 210
  763. '
  764. '
  765. ' *  RESET THE MODEM VIA THE MODEM CONTROL REGISTER  TO ASSURE IT IS READY
  766. '
  767. '
  768.     OUT ZModemCntlReg,&H4
  769.     CALL DelayTime (ZModemInitWaitTime)
  770. '
  771. '
  772. ' *  CLEAR THE MODEM CONTROL REGISTER PRIOR TO OPEN THE COMMUNICATIONS PORT
  773. '
  774. '
  775.     OUT ZModemCntlReg,&H0
  776.     CALL DelayTime (ZModemInitWaitTime)
  777. 210 IF ZPrivateDoor THEN _
  778.        CALL Transfer : _
  779.        GOTO 235
  780.     CALL OpenCom(ZModemInitBaud$,",N,8,1")
  781. 220 CALL AMorPM
  782. 230 CALL Printit (" RBBS-PC " + ZVersionID$ + " Node " + _
  783.                     ZNodeID$ + " up " + ZTime$ + " on " + DATE$)
  784. 235 ZEightBit = ZTrue
  785.     ZSubParm = -10
  786.     CALL Carrier
  787.     IF ZSubParm = 0 AND _
  788.        ZExitToDoors THEN _
  789.        CALL ReadProf : _
  790.        ZSubParm = 1 : _
  791.        GOTO 335
  792.     IF ZSubParm = 0 AND _
  793.        ZExpectActiveModem THEN _
  794.        ZBaudTest! = VAL(ZNetBaud$) : _
  795.        CALL TestRel (ZNetReliable$) : _
  796.        GOTO 328
  797.     IF ZExpectActiveModem OR _
  798.        ZExitToDoors THEN _
  799.        ZSubParm = 4 : _
  800.        EXIT SUB
  801.     IF ZSubParm = 0 THEN _
  802.        ConnectDelay! = TIMER + ZMaxCarrierWait : _
  803.        GOTO 324
  804.     PCJr = ZFalse
  805.     IF ZComputerType = 2 AND _
  806.        ZComPort$ = "COM1" AND _
  807.        ZModemStatusReg = 1022 THEN _
  808.        ZModemGoOffHookCmd$ = CHR$(14) + _
  809.                                    "P" : _
  810.        PCJr = ZTrue
  811.     CALL SysMenu
  812.     IF PCJr THEN _
  813.        ZOutTxt$ = CHR$(14) + _
  814.             "I" _
  815.     ELSE ZOutTxt$ = ZModemResetCmd$
  816.     CALL ModemPut (ZOutTxt$)
  817.     CALL DelayTime (ZModemInitWaitTime)
  818.     IF PCJr THEN _
  819.        ZOutTxt$ = CHR$(14) + _   ' PC-JR's MODEM COMMAND IDENTIFIER
  820.               "C 0," + _   ' SET "AUTO-ANSWER" OFF ON PC-JR'S MODEM
  821.               "S 1," + _   ' SET SPEED TO 300 BAUD ON PC-JR'S MODEM
  822.               "H" _        ' MANUALLY HANG UP THE PHONE (IF NOT ALREADY)
  823.     ELSE ZOutTxt$ = ZModemInitCmd$
  824.     CALL ModemPut (ZOutTxt$)
  825.     IF PCJr THEN _
  826.        ZOutTxt$ = CHR$(14) + _
  827.             "F 4" : _
  828.        CALL ModemPut (ZOutTxt$)
  829.     RingBack = ZFalse
  830.     LOCATE 16,55
  831.     IF ZRequiredRings = 0 THEN _
  832.        CALL LPrnt("WAITING FOR CARRIER",0) : _
  833.        GOTO 237
  834.     IF MID$(ZModemInitCmd$, _
  835.           INSTR(ZModemInitCmd$,"S0") + 3,3) = "255" THEN _
  836.        CALL LPrnt("RING BACK SYSTEM",0) : _
  837.        RingBack = ZTrue : _
  838.        GOTO 236
  839.     CALL LPrnt(" WAITING FOR RING ",0)
  840. 236 LOCATE 16,76 : _
  841.     CALL LPrnt(MID$(STR$(ZRequiredRings),2),0)
  842. 237 LOCATE 18,76
  843.     IF ZDosANSI THEN _
  844.        CALL LPrnt(ZEscape$ + "[05m" + "YES" + ZEscape$ + "[00m",0) _
  845.     ELSE CALL LPrnt ("YES",0)
  846.     COLOR ZFG,ZBG,ZBorder
  847.     LOCATE 20,56
  848. '
  849. '
  850. ' *  GET READY TO ANSWER INCOMMING CALL:
  851. ' *       1.  LET THE MODEM "AUTO-ANSWER" FOR RBBS-PC.
  852. ' *           REQUIRED RINGS = 0 AND S0 = 1 IN MODEM INIT COMMAND.
  853. ' *       2.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS.
  854. ' *           REQUIRED RINGS > 0 AND S0 = 254 IN MODEM Init COMMAND.
  855. ' *       3.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS AFTER A USER
  856. ' *           First CALLS AND THEN HANGS UP (I.E. RING-BACK).
  857. ' *           REQUIRED RINGS > 0 AND S0 = 255 IN MODEM INIT COMMAND.
  858. '
  859. '
  860.     WasQQ = 255
  861.     WasI = INSTR(ZModemInitCmd$,"S0")
  862.     IF WasI = 0 OR PCJr THEN _
  863.        GOTO 239
  864.     IF VAL(MID$(ZModemInitCmd$,WasI + 3,3)) = 255 THEN _
  865.        WasQQ = 0 : _
  866.        ZBlk = WasQQ
  867.     ZSecsUsedSession! = TIMER
  868.     ZSubParm = 1
  869.     CALL Line25
  870.     RingAnswer = ZTrue
  871.     IF RingBack THEN _
  872.        RingAnswer = ZFalse
  873. 239 RingBackWaitStart! = 0
  874.     IF RingBack THEN _
  875.        RingBackWaitStart! = TIMER : _
  876.        COLOR 7,0,0 _
  877.     ELSE COLOR ZFG,ZBG,ZBorder
  878. 240 IF ZSysopNext THEN _
  879.        ZSubParm = 3 : _
  880.        EXIT SUB
  881. '
  882. '
  883. ' * WAIT FOR INCOMING CALLS
  884. '
  885. '
  886.     ScreenCleared = ZFalse
  887. 245 InactiveDelay! = TIMER + (60 * ZRecycleWait)
  888.     NoCall = ZTrue
  889.     CALL FlushCom (ModemResponse$)
  890.     ModemResponse$ = ""
  891. 247 IF INP(ZModemStatusReg) > 127 OR (NOT NoCall) THEN _
  892.        GOTO 274
  893.        CALL FindFKey
  894.        IF ZSubParm < 0 THEN _
  895.           EXIT SUB
  896. 250    IF ZKeyPressed$ = ZEscape$ THEN _
  897.           ZSubParm = 3 : _
  898.           EXIT SUB
  899.        IF ZKeyPressed$ <> "" THEN _
  900.           GOTO 235
  901. 260    IF RingBackWaitStart! > 0 THEN _
  902.           CALL CheckTime(RingBackWaitStart!, TempElapsed!, 2) : _
  903.           IF TempElapsed! > 45 THEN _
  904.              RingBackWaitStart! = 0 : _
  905.              RingBackCount = 0 : _
  906.              RingAnswer = ZFalse: _
  907.              IF RingBack THEN _
  908.                LOCATE 20,56 : _
  909.                CALL LPrnt("Ringback timeout" + ZPagingPtrSupport$,1)
  910. 265    CALL CheckTime(ZSecsUsedSession!, TempElapsed!, 2)
  911.        IF TempElapsed! > 120 AND NOT ScreenCleared THEN _
  912.           LOCATE ,,0 : _
  913.           CLS : _
  914.           ZWasCL = 1 : _
  915.           ScreenCleared = ZTrue : _
  916.           ZSecsUsedSession! = TIMER
  917.        IF ZTimeToDropToDos! > 0 THEN _
  918.           IF ZOldDate$ <> DATE$ THEN _
  919.           IF TIMER => ZTimeToDropToDos! AND _ 
  920.              TIMER < 86340 THEN _               ' Skip btw 23:59 and 00:00
  921.                 ZSubParm = 7 : _
  922.                 EXIT SUB
  923. 266    IF (INP(ZModemStatusReg) AND &H40) > 0 AND _
  924.           ZRequiredRings > 0 THEN _
  925.           GOTO 276
  926. 270    IF ZRecycleWait > 0 THEN _
  927.           CALL CheckTime(InactiveDelay!, TempElapsed!, 1) : _
  928.           IF TempElapsed! <= 0 THEN _
  929.              ZSubParm = 8 : _
  930.              EXIT SUB
  931.        CALL FlushCom (WasX$)
  932.        IF LEN(WasX$) > 0 THEN _
  933.           ModemResponse$ = ModemResponse$ + WasX$ : _
  934.           RingDetected = (INSTR(ModemResponse$,"RING") > 0) : _
  935.           ConnectDetected = (INSTR(ModemResponse$,"ONNECT") > 0) : _
  936.           NoCall = (NOT RingDetected) AND (NOT ConnectDetected)
  937.     IF RingDetected AND ZRequiredRings > 0 THEN _
  938.        MID$(ModemResponse$, INSTR(ModemResponse$,"RING")+1,1) = "A" : _
  939.        RingDetected = ZFalse : _
  940.        GOTO 276
  941.     CALL GoIdle
  942.     GOTO 247
  943. 274 IF NOT RingBack THEN _
  944.        IF ConnectDetected THEN _
  945.           GOTO 321
  946.     IF ZRequiredRings = 0 THEN _
  947.        CALL DelayTime (3) : _
  948.        GOTO 321
  949. '
  950. '
  951. ' * PREPARE TO ANSWER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 254) OR
  952. ' * THE CALL AFTER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 255) --
  953. ' * "RING BACK."
  954. '
  955. '
  956. 276 CALL EofComm (Char)
  957.     IF Char <> -1 THEN _
  958.        CALL FlushCom(WasX$) : _
  959.        IF ZSubParm = - 1 THEN _
  960.           EXIT SUB
  961.     IF PCJr THEN _
  962.        GOTO 320
  963.     ZOutTxt$ = ZModemCountRingsCmd$
  964.     CALL ModemPut (ZOutTxt$)
  965.     CALL DelayTime (ZModemCmdDelayTime)
  966. 290 CALL FlushCom(WasX$)
  967.     IF ZSubParm = -1 THEN _
  968.        EXIT SUB
  969. 291 IF LEN(WasX$) = 0 THEN _
  970.        GOTO 310
  971. 292 IF INSTR(WasX$,"0") < 1 THEN _
  972.        GOTO 293
  973.     WasX$ = MID$(WasX$,INSTR(WasX$,"0"),4)
  974. 293 IF (NOT RingAnswer) AND (VAL(WasX$) < RingBackCount) THEN _
  975.        RingAnswer = ZTrue
  976. 300 RingBackCount = VAL(WasX$)
  977.     ZWasQ = RingBackCount + 1
  978.     IF (NOT RingAnswer) THEN _
  979.        ZWasQ = 0
  980. 305 LOCATE 20,56
  981.     CALL LPrnt(TIME$ + " Ring " + STR$(ZWasQ),0)
  982. 310 IF (RingBackCount + 1 < ZRequiredRings) OR _
  983.        (NOT RingAnswer) THEN _
  984.        GOTO 239
  985. 320 IF PCJr THEN _
  986.        ZOutTxt$ = CHR$(14) + _   ' PC-JR'S MODEM COMMAND IDENTIFIER
  987.             "T 0," + _     ' SET PC-JR'S MODEM TO TRANSPARENT MODE PERMANENTLY
  988.             "M" _          ' TELL THE PC-JR'S MODEM TO ANSWER IN DATA MODE
  989.     ELSE ZOutTxt$ = ZModemAnswerCmd$
  990.     CALL ModemPut (ZOutTxt$)
  991. '
  992. '
  993. ' *  TEST FOR Carrier PRESENT
  994. '
  995. '
  996. 321 ConnectDelay! = TIMER + ZMaxCarrierWait
  997. 322 CALL CheckTime(ConnectDelay!, TempElapsed!, 1)
  998. 323 ZSubParm = -10
  999.     CALL Carrier
  1000.     IF ZSubParm AND _
  1001.        TempElapsed! > 0 THEN _
  1002.        GOTO 322
  1003.     IF ZSubParm THEN _
  1004.        ZSubParm = 4 : _
  1005.        EXIT SUB
  1006.     CALL DelayTime (3)
  1007. 324 ZSubParm = 0
  1008.     CALL CheckTime(ConnectDelay!, TempElapsed!, 1)
  1009.     IF TempElapsed! <= 0 THEN _
  1010.        CALL UpdtCalr ("Connect timeout",1) : _
  1011.        ZSubParm = 4 : _
  1012.        EXIT SUB
  1013. 325 CALL FlushCom(WasX$)
  1014.     IF ZSubParm = -1 THEN _
  1015.        IF ZErrCode = 69 THEN _
  1016.           ZSubParm = 5 : _
  1017.        EXIT SUB
  1018.     ModemResponse$ = ModemResponse$ + WasX$
  1019.     IF LEN(ModemResponse$) > 200 THEN _
  1020.        ModemResponse$ = RIGHT$(ModemResponse$,20)
  1021.     CALL CheckTime(ConnectDelay!, TempElapsed!, 1)
  1022.     IF TempElapsed! <= 0 THEN _
  1023.        CALL UpdtCalr ("Connect timeout",1) : _
  1024.        ZSubParm = 4 : _
  1025.        EXIT SUB
  1026.     IF ZDumbModem THEN _
  1027.        ZBaudTest! = VAL(ZModemInitBaud$) : _
  1028.        GOTO 327
  1029.     IF INSTR(ModemResponse$,"FAST") THEN _
  1030.        ZBaudTest! = 19200 : _
  1031.        GOTO 327
  1032.     IF INSTR(ModemResponse$,"ONNECT") THEN _
  1033.        ZBaudTest! = VAL(MID$(ModemResponse$,INSTR(ModemResponse$,"ONNECT") + 7)) : _
  1034.        GOTO 327
  1035.     IF INSTR(ModemResponse$,"ONLINE") THEN _
  1036.        ZBaudTest! = VAL(MID$(ModemResponse$,INSTR(ModemResponse$,"ONLINE") + 7)) : _
  1037.        GOTO 327
  1038.     GOTO 324
  1039. 327 CALL TestRel (ModemResponse$)
  1040. 328 IF ZBaudTest! = 0 OR ZBaudTest! = 300 THEN _
  1041.        ZBaudTest! = 300 : _
  1042.        ZBPS = -1 : _
  1043.        GOTO 331
  1044.     IF ZBaudTest! = 1200 OR ZBaudTest! = 1275 THEN _
  1045.        ZBPS = -3 : _
  1046.        GOTO 331
  1047.     IF ZBaudTest! = 2400 THEN _
  1048.        ZBPS = -4 : _
  1049.        GOTO 331
  1050.     IF ZBaudTest! = 4800 OR ZBaudTest! = 9600 THEN _
  1051.        ZBPS = -4-(ZBaudTest! /4800) : _
  1052.        GOTO 331
  1053.     IF ZBaudTest! = 19200 THEN _
  1054.        ZBPS = -7 : _
  1055.        GOTO 331
  1056.     IF ZBaudTest! = 38400 THEN _
  1057.        ZBPS = -8 : _
  1058.        GOTO 331
  1059.     GOTO 324
  1060. 331 CALL SetBaud
  1061.     ZSubParm = 2
  1062. 335 DontWrite = 0
  1063.     END SUB
  1064. 336 ' $SUBTITLE: 'TestRel - Test for Reliable mode connection'
  1065. ' $PAGE
  1066. '
  1067. '  NAME    -- TestRel
  1068. '
  1069. '  INPUTS  --     PARAMETER                    MEANING
  1070. '                 Strng$                 String to check for reliable
  1071. '
  1072. '  OUTPUTS --    ZReliableMode          Reliable mode indicator
  1073. '
  1074. '  PURPOSE -- To test for reliable connect
  1075. '
  1076.     SUB TestRel (Strng$) STATIC
  1077.     ZReliableMode = ZFalse
  1078.     IF Strng$ = "" THEN _
  1079.        EXIT SUB
  1080.     IF INSTR(Strng$,"REL") OR _
  1081.        INSTR(Strng$,"R C") OR _       (ERROR CONTROL)
  1082.        INSTR(Strng$,"ARQ") OR _
  1083.        INSTR(Strng$,"LAP") OR _
  1084.        INSTR(Strng$,"AFT") OR _
  1085.        INSTR(Strng$,"MNP") THEN _
  1086.          ZReliableMode = -1
  1087.     END SUB
  1088. 455 ' $SUBTITLE: 'BadChar - sub to check user names for bad characters'
  1089. ' $PAGE
  1090. '
  1091. '  NAME    -- BadChar
  1092. '
  1093. '  INPUTS  --     PARAMETER                    MEANING
  1094. '                 PassedName$                  USER NAME
  1095. '
  1096. '  OUTPUTS --    PassedName$            USER NAME WILL CONTAIN ""
  1097. '                                       IF BAD CHARACTERS Found
  1098. '
  1099. '  PURPOSE -- To check user names for invalid characters
  1100. '
  1101.     SUB BadChar (PassedName$) STATIC
  1102.     WasJ = 1
  1103.     WasXX = LEN(PassedName$)
  1104. 457 IF WasJ > WasXX THEN _
  1105.        EXIT SUB
  1106.     WasX$ = MID$(PassedName$,WasJ,1)
  1107.     IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ '-./0123456789",WasX$) = 0 THEN _
  1108.        PassedName$ = "" : _
  1109.        EXIT SUB
  1110.     WasJ = WasJ + 1
  1111.     GOTO 457
  1112.     END SUB
  1113. 660 ' $SUBTITLE: 'PassWrd - verify User and Message passwords'
  1114. ' $PAGE
  1115. '
  1116. '  NAME    -- PassWrd
  1117. '
  1118. '  INPUTS  --     PARAMETER                    MEANING
  1119. '                 ZSubParm         = 1      VERIFY USER PASSWORD
  1120. '                                  = 2      VERIFY MESSAGE PASSWORD
  1121. '                                  = 3      VERIFY MESSAGE PASSWORD
  1122. '                                  = 4      VERIFY MESSAGE PASSWORD
  1123. '                                  = 5      VERIFY MESSAGE PASSWORD
  1124. '
  1125. '  OUTPUTS -- ZPswdFailed                   SET TO 0 IF PASSED
  1126. '                                           SET TO -1 IF FAILED
  1127. '
  1128. '  PURPOSE -- To verify user and message passwords
  1129. '
  1130.     SUB PassWrd STATIC
  1131.     ZErrCode = 0
  1132.     ON ZSubParm GOTO 665,667,670,675,677
  1133. 665 IF ZPswdSave$ = ZPswd$ THEN _
  1134.        ZPswdFailed = 0 : _
  1135.        EXIT SUB
  1136. 667 Attempts = 0
  1137. 670 Attempts = Attempts + 1
  1138.     IF Attempts > ZAttemptsAllowed THEN _
  1139.        ZPswdFailed = ZTrue : _
  1140.        EXIT SUB
  1141. 675 ZOutTxt$ = "Enter Password"
  1142.     ZHidden = ZTrue
  1143.     CALL PopCmdStack
  1144.     IF ZSubParm < 0 THEN _
  1145.        ZPswdFailed = ZTrue : _
  1146.        EXIT SUB
  1147.     ZHidden = ZFalse
  1148.     ZWasZ$ = ZUserIn$
  1149. 677 IF LEN(ZWasZ$) > 15 THEN _
  1150.        GOTO 680
  1151.     IF ZErrCode <> 0 THEN _
  1152.        GOTO 670
  1153.     CALL AllCaps (ZWasZ$)
  1154.     ZWasZ$ = ZWasZ$ + SPACE$(15 - LEN(ZWasZ$))
  1155.     IF ZPswdSave$ = ZWasZ$ THEN _
  1156.        ZPswdFailed = 0 : _
  1157.        ZOutTxt$ = "" : _
  1158.        EXIT SUB
  1159. 680 CALL QuickTPut1 ("Wrong password ")
  1160.     ZLastIndex = 0
  1161.     IF NOT ZMsgPswd THEN _
  1162.        CALL UpdtCalr (ZActiveUserName$+" PW fail: " + ZWasZ$,1)
  1163.     GOTO 670
  1164.     END SUB
  1165. 945 ' $SUBTITLE: 'Line25 - sub to build/display RBBS-PCs line 25'
  1166. ' $PAGE
  1167. '
  1168. '  NAME    -- Line25
  1169. '
  1170. '  INPUTS  --     PARAMETER                    MEANING
  1171. '                 ZSubParm           = 1  BUILD DISPLAY FOR LINE 25
  1172. '                                    = 2  UPDATE LINE 25
  1173. '                 ZLockStatus$            STATUS OF LOCKS IN A MULTI-
  1174. '                                         USER ENVIRONMENT OR TIME OF
  1175. '                                         DAY USER LOGGED ON OR THE
  1176. '                                         RE-CYCLED
  1177. '
  1178. '  OUTPUTS -- ZCursorLine                 CURRENT LINE ON SCREEN
  1179. '             ZCursorRow                  CURRENT ROW ON ZCursorLine
  1180.  
  1181. '
  1182. '  PURPOSE -- To build or update RBBS-PC's line 25 displayed
  1183. '             on the PC screen that is running RBBS-PC.
  1184. '
  1185.       SUB Line25 STATIC
  1186.       IF ZSubParm = 2 THEN _
  1187.          GOTO 950
  1188. '
  1189. '
  1190. ' *  BUILD LINE 25 DISPLAY
  1191. '
  1192. '
  1193. 949 ZLine25$ = "Node " + _
  1194.                ZNodeID$ + " " + _
  1195.                ZPageStatus$ + " " + _
  1196.                MID$("    AVL ",1 - 4 * ZSysopAvail,4) + _
  1197.                MID$("    ANY ",1 - 4 * ZSysopAnnoy,4) + _
  1198.                MID$("    LPT ",1 - 4 * ZPrinter,4) + _
  1199.                MID$("SYS",1,-3 * ZSysopNext) + _
  1200.                MID$(" XOFF",1,-5 * ZXOffEd) + _
  1201.                MID$(" CTS",1,-4 * ZNotCTS)
  1202. '
  1203. '
  1204. ' *  LINE 25 UPDATE ROUTINE
  1205. '
  1206. '
  1207. 950 IF NOT ZSnoop THEN _
  1208.        EXIT SUB
  1209.     ZCursorLine = CSRLIN
  1210.     ZCursorRow = POS(0)
  1211.     ZWasHH = LEN(ZActiveUserName$) + _
  1212.          LEN(ZWasCI$) + _
  1213.          LEN(ZLine25$) + _
  1214.          LEN(STR$(ZUserSecLevel)) + _
  1215.          LEN(STR$(INT(MinsRemaining))) + _                        'DGS-008
  1216.          18
  1217.    ' IF ZAutoDownYes THEN _
  1218.    '    ZWasHH = ZWasHH + 4
  1219.     LOCATE 25,1
  1220.     IF ZNetworkType = 0 THEN _
  1221.         ZLockStatus$ = SPACE$(2) + _                 'Pe 02/03/90
  1222.                            LEFT$(ZTimeLoggedOn$,5)   'Pe 02/03/90
  1223.     IF ZWasHH > 79 THEN _
  1224.        ZWasHH = 78
  1225.     ZLine25Hold$ = ZLine25$ + _
  1226.                     SPACE$(79 - ZWasHH) + _
  1227.                     STR$(ZUserSecLevel) + _
  1228.                     " " + _
  1229.                     ZActiveUserName$ + _
  1230.                     " " + _
  1231.                     ZWasCI$ + _
  1232.                     " " + _
  1233.                     STR$(INT(MinsRemaining)) + _                  'DGS-008
  1234.                     " " + _
  1235.                     ZLockStatus$
  1236.     TempBasicWrites = ZUseBASICWrites
  1237.     ZUseBASICWrites = ZTrue
  1238.     CALL LPrnt(ZLine25Hold$,0)
  1239.     ZUseBASICWrites = TempBasicWrites
  1240.     LOCATE ZCursorLine,ZCursorRow
  1241.     END SUB
  1242. 1238 ' $SUBTITLE: 'SearchCmd    - sub to search command list'
  1243. ' $PAGE
  1244. '
  1245. '  NAME    -- SearchCmd
  1246. '
  1247. '  INPUTS  -- PARAMETER             MEANING
  1248. '             StartPos         POSITION TO BEGIN SEARCH AT
  1249. '             ZAllOpts$        STRING TO SEARCH (COMMAND LIST)
  1250. '             ZWasZ$            WHAT TO LOOK FOR
  1251. '
  1252. '  OUTPUTS -- WhereFound   POSITION OF ZWasZ$ IN ZAllOpts$
  1253. '                           0 IF NOT Found
  1254. '
  1255. '  PURPOSE -- Searches valid command list for the requested
  1256. '             command.  If the sysop has configured RBBS-PC to
  1257. '             restrict commands to only those valid within the
  1258. '             RBBS-PC subsystem, then only those commands and
  1259. '             "GLOBAL" commands are valid.  Otherwise all commands
  1260. '             are valid from any of the RBBS-PC subsections.
  1261. '
  1262.      SUB SearchCmd (StartPos,WhereFound) STATIC
  1263. 1240 IF LEN(ZWasZ$) < 1 THEN _
  1264.         WhereFound = 0 : _
  1265.         EXIT SUB
  1266.      CALL Trim (ZWasZ$)
  1267.      CALL AllCaps (ZWasZ$)
  1268.      ZWasY$ = LEFT$(ZWasZ$,1)
  1269.      WhereFound = INSTR(StartPos,ZAllOpts$,ZWasY$)
  1270.      IF WhereFound = 0 THEN _  'Not found: decide whether to hunt further
  1271.         IF StartPos < 2 OR ZRestrictValidCmds THEN _
  1272.            GOTO 1242 _  ' fully searched or restricted
  1273.         ELSE WhereFound = INSTR(1,ZAllOpts$,ZWasY$) : _ 'hunt further
  1274.              GOTO 1242
  1275.      IF WhereFound => ZBegLibrary THEN _
  1276.         IF WhereFound < LEN(ZAllOpts$) - 11 THEN _
  1277.            IF ZLibType = 0 THEN _
  1278.               WhereFound = INSTR(WhereFound+1,AllOpt$,ZWasY$) : _
  1279.               IF WhereFound = 0 THEN _
  1280.                  WhereFound = INSTR(1,ZAllOpts$,ZWasY$) : _
  1281.                  IF WhereFound >= ZBegLibrary OR WhereFound = 0 THEN _
  1282.                     WhereFound = 0 : _
  1283.                     GOTO 1242
  1284.      IF NOT ZRestrictValidCmds THEN _
  1285.         GOTO 1242            ' everything found valid
  1286. '
  1287. '
  1288. ' * RESTRICT COMMANDS TO SUBSYSTEMS (EXCEPT GLOBAL AND SYSOP)
  1289. '
  1290. '
  1291.      IF WhereFound > LEN(ZAllOpts$) - 11 THEN _
  1292.         IF ZUserSecLevel < ZOptSec(WhereFound) THEN _
  1293.            WhereFound = 0 : _
  1294.            EXIT SUB _
  1295.         ELSE GOTO 1242
  1296.      IF MID$(ZOrigCommands$,WhereFound,1) = "G" THEN _
  1297.         GOTO 1242          ' ACCEPT GOODBYE/GRAPHICS
  1298.      IF (WhereFound < StartPos) OR _
  1299.         (StartPos < ZBegFile AND WhereFound => ZBegFile ) OR _
  1300.         (StartPos < ZBegUtil AND WhereFound => ZBegUtil ) OR _
  1301.         (StartPos < ZBegLibrary AND WhereFound => ZBegLibrary ) THEN _
  1302.            WhereFound = 0                 ' REJECT: NOT IN Section
  1303. 1242 IF WhereFound > 0 THEN _
  1304.         LSET ZLastCommand$ = ZActiveMenu$ + MID$(ZOrigCommands$,WhereFound) : _
  1305.         EXIT SUB
  1306.      IF ZMacroActive OR LEN(ZWasZ$) <> 1 THEN _
  1307.         EXIT SUB
  1308.      CALL Macro (ZWasZ$,Found)
  1309.      IF Found THEN _
  1310.         CALL FDMACEXE : _
  1311.         ZWasZ$ = ZUserIn$(1) : _
  1312.         GOTO 1240
  1313.      END SUB
  1314. 1320 ' $SUBTITLE: 'CheckMacro - sub to check if macro exists & process'
  1315. ' $PAGE
  1316. '
  1317. '  NAME    -- CheckMacro
  1318. '
  1319. '  INPUTS  -- PARAMETER             MEANING
  1320. '             Strng$               STRING TO CHECK IF IS A MACRO
  1321. '             ZMacroDrvPath$       DRIVE/PATH WHERE MACROS ARE
  1322. '             ZMacroExtension$     EXTENSION WasOF MACROS
  1323. '             MACRO.OFF            FORCE NO MACRO TO BE Found
  1324. '
  1325. '  OUTPUTS -- MacroFound           WHETHER A MACRO WAS Found
  1326. '             Strng$               SUBSTITUTE FOR COMMANDS
  1327. '             ZCommPortStack$      REST OF MACRO
  1328. '                                  0 IF NOT Found
  1329. '
  1330. '  PURPOSE -- Macro file is checked for security (1st line).
  1331. '             2nd line is substituted for passed string
  1332. '             and parsed.  Remaining part of macro put into
  1333. '             stack to be executed.
  1334. '
  1335.      SUB CheckMacro (Strng$,MacroFound) STATIC
  1336.      MacroFound = ZFalse
  1337.      IF ZMacroExtension$ = "" OR INSTR(Strng$,".") > 0 THEN _
  1338.         EXIT SUB
  1339.      IF LEN(Strng$) < ZMacroMin THEN _
  1340.         ZMacroMin = 1 : _
  1341.         EXIT SUB
  1342.      IF LEN(Strng$) = 1 THEN _
  1343.         Temp$ = Strng$ : _
  1344.         CALL AllCaps (Temp$) : _
  1345.         IF INSTR(ZAllOpts$,Temp$) > 0 THEN _
  1346.            EXIT SUB
  1347.      CALL Macro (Strng$,MacroFound)
  1348.      END SUB
  1349. 1325 ' $SUBTITLE: 'Macro - check if macro exists & process'
  1350. ' $PAGE
  1351. '
  1352. '  NAME    -- Macro
  1353. '
  1354. '  INPUTS  -- PARAMETER             MEANING
  1355. '             Strng$           STRING TO CHECK IF IS A MACRO
  1356. '             ZMacroDrvPath$   DRIVE/PATH WHERE MACROS ARE
  1357. '             ZMacroExtension$ EXTENSION OF MACROS
  1358. '             MACRO.OFF        FORCE NO MACRO TO BE Found
  1359. '
  1360. '  OUTPUTS -- MacroFound       WHETHER A MACRO WAS Found
  1361. '             Strng$           SUBSTITUTE FOR COMMANDS
  1362. '             ZCommPortStack$  REST OF MACRO
  1363. '                              0 IF NOT Found
  1364. '
  1365. '  PURPOSE -- Executes a macro if found.  Does not check if macro
  1366. '             letter uses a command.
  1367.      SUB Macro (Strng$,MacroFound) STATIC
  1368.      MacroFound = ZFalse
  1369.      Temp$ = Strng$
  1370.      CALL BreakFileName (Temp$,ZWasDF$,Prefix$,WasX$,ZFalse)
  1371.      IF Temp$ = Prefix$ THEN _
  1372.         FilName$ = ZMacroDrvPath$ + Strng$ + ZMacroExtension$ _
  1373.      ELSE FilName$ = Strng$
  1374.      CALL BadFile (FilName$,ZWasA)
  1375.      IF ZWasA > 1 THEN _
  1376.         EXIT SUB
  1377.      CALL GRAPHICX (ZUserGraphicDefault$,FilName$,6)
  1378.      IF NOT ZOK THEN _
  1379.         EXIT SUB
  1380.      CALL ReadDir (6,1)
  1381.      IF ZErrCode > 0 THEN _
  1382.         EXIT SUB
  1383.      CALL CheckInt (ZOutTxt$)
  1384.      IF ZErrCode > 0 OR ZUserSecLevel < ZTestedIntValue THEN _
  1385.         EXIT SUB
  1386.      ZWasA = INSTR(ZOutTxt$,"/")
  1387.      IF ZWasA > 0 THEN _    ' Check macro contraint
  1388.         WasX$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-ZWasA) : _
  1389.         IF RIGHT$(WasX$,1) = "/" THEN _
  1390.            IF ZLastCommand$ <> LEFT$(WasX$,LEN(WasX$)-1) THEN _
  1391.               EXIT SUB _
  1392.            ELSE GOTO 1327 _
  1393.         ELSE IF LEFT$(ZLastCommand$,LEN(WasX$)) <> WasX$ THEN _
  1394.                 EXIT SUB
  1395. 1327 ZMacroActive = ZTrue
  1396.      MacroFound = ZTrue
  1397.      ZMacroEcho = ZTrue
  1398.      END SUB
  1399. 1330 ' $SUBTITLE: 'ViewHelp    - Processes requests for help'
  1400. ' $PAGE
  1401. '
  1402. '  NAME    -- ViewHelp
  1403. '
  1404. '  INPUTS  -- PARAMETER             MEANING
  1405. '            Section             ORDER OF 1ST COMMAND IN CURRENT
  1406. '                                Section
  1407. '            GRAPHICS.DEFAULT    WHAT GRAPHICS TYPE USER WANTS
  1408. '            HelpDefault$        HELP GET IF PRESS ENTER
  1409. '            ZHelpPath$
  1410. '            ZHelpExtension$
  1411. '            ZBegFile
  1412. '            ZBegMain
  1413. '            ZBegUtil
  1414. '            ZBegLibrary
  1415. '
  1416. '  OUTPUTS -- DISPLAYS HELP
  1417. '
  1418. '  PURPOSE -- The main help processor for RBBS.  Puts up the
  1419. '             optional menu.  Accepts help with individual commands.
  1420. '
  1421.      SUB ViewHelp (Section,GraphicDefault$,HelpDefault$) STATIC
  1422.      HelpMenu$ = ZHelpPath$ + _
  1423.                   "HELP" + _
  1424.                   ZHelpExtension$
  1425.      SotMenu = ZTrue
  1426.      IF ZWasQ > 1 THEN _
  1427.         ZAnsIndex = 2 : _
  1428.         ZLastIndex = ZWasQ: _
  1429.         FastHelp = ZTrue : _
  1430.         GOTO 1332
  1431. 1331 IF SotMenu THEN _
  1432.         ZFileName$ = HelpMenu$ : _
  1433.         GOSUB 1350 : _
  1434.         SotMenu = ZFalse
  1435.      ZAnsIndex = 1
  1436.      ZOutTxt$ = "Which command or topic do you need help with" + _   ' Bh
  1437.           ZPressEnterExpert$
  1438.      ZSubParm = 1
  1439.      CALL TGet
  1440.      IF ZSubParm = -1 THEN _
  1441.         EXIT SUB
  1442.      IF ZWasQ = 0 THEN _
  1443.         EXIT SUB
  1444.      ZLastIndex = ZWasQ
  1445. 1332 ZWasZ$ = ZUserIn$(ZAnsIndex)
  1446.      CALL AllCaps (ZWasZ$)
  1447.      IF ZWasZ$ = "?" THEN _
  1448.         ZWasZ$ = "H"
  1449.      CALL BadFile (ZWasZ$,BadFileNameIndex)
  1450.      ON BadFileNameIndex GOTO 1333,1340,1340
  1451. 1333 IF LEN(ZWasZ$) <> 1 THEN _
  1452.         GOTO 1335
  1453.      CALL SearchCmd (Section,ZFF)
  1454.      IF ZFF < 1 THEN _
  1455.         ZOK = ZFalse : _
  1456.         GOTO 1336
  1457.      IF ZFF > LEN(ZAllOpts$) - 11 THEN _
  1458.         IF ZFF > LEN(ZAllOpts$) - 7 AND NOT ZSysop THEN _
  1459.            ZOK = ZFalse : _
  1460.            GOTO 1336 _
  1461.         ELSE ZWasZ$ = MID$(ZOrigCommands$,ZFF,1) : _
  1462.              GOTO 1335 _
  1463.      ELSE WasX = - (ZFF => ZBegMain) - (ZFF => ZBegFile) - (ZFF => ZBegUtil) - (ZFF => ZBegLibrary) : _
  1464.           ZWasZ$ = MID$("MFU@",WasX,1) + _
  1465.                    MID$(ZOrigCommands$,ZFF,1)
  1466. 1335 ZFileName$ = ZHelpPath$ + _
  1467.                   ZWasZ$ + _
  1468.                   ZHelpExtension$
  1469.      GOSUB 1350
  1470. 1336 IF NOT ZOK THEN _
  1471.         ZOutTxt$ = "No help for " + _
  1472.              ZWasZ$ : _
  1473.         CALL QuickTPut1 (ZOutTxt$) : _
  1474.         CALL UpdtCalr (ZOutTxt$,2)
  1475.      ZAnsIndex = ZAnsIndex + 1
  1476.      IF ZAnsIndex <= ZLastIndex THEN _
  1477.         GOTO 1332
  1478.      IF FastHelp THEN _
  1479.         FastHelp = ZFalse : _
  1480.         EXIT SUB
  1481.      GOTO 1331
  1482. 1340 ZOK = ZFalse
  1483.      GOTO 1336
  1484. 1350 CALL Graphic (GraphicDefault$,ZFileName$)
  1485.      CALL BufFile (ZFileName$,WasX)
  1486.      RETURN
  1487.      END SUB
  1488. 1380 ' $SUBTITLE: 'VIOLATION - handles all security violations'
  1489. ' $PAGE
  1490. '
  1491. '  NAME    -- SecViolation
  1492. '
  1493. '  INPUTS  --     PARAMETER                    MEANING
  1494. '
  1495. '  OUTPUTS -- ZCursorLine               CURRENT LINE ON SCREEN
  1496. '             ZCursorRow                CURRENT ROW ON ZCursorLine
  1497. '
  1498. '  PURPOSE -- Inform caller of security violation, augment count of
  1499. '             violations and determine whether too many occurred.
  1500. '
  1501.      SUB SecViolation STATIC
  1502.      CALL FlushKeys
  1503.      CALL BufFile (ZSecVioHelp$,WasX)
  1504.      IF NOT ZOK THEN _
  1505.         CALL QuickTPut1 ("Sorry, " + ZFirstName$ + ", action not permitted")
  1506.      CALL UpdtCalr ("SV!-" + ZViolation$,2)
  1507.      ZLastIndex = 0
  1508. '     CALL Muzak (3)
  1509.      ZViolationsThisSession = ZViolationsThisSession + 1
  1510.      IF ZMaxViolations = 0 OR ZViolationsThisSession <= ZMaxViolations THEN _
  1511.         EXIT SUB
  1512. 1385 IF ZUserFileIndex < 1 THEN _
  1513.         EXIT SUB
  1514.      ZOutTxt$ = "SECURITY VIOLATION!  Sysop can reinstate"
  1515.      IF ZUserSecLevel <= ZMinLogonSec THEN _
  1516.         ZOutTxt$ = "" : _
  1517.         ZUserSecLevel = ZUserSecLevel - 1 _
  1518.      ELSE ZUserSecLevel = ZMinLogonSec
  1519.      ZDenyAccess = ZTrue
  1520.      END SUB
  1521. 1386 ' $SUBTITLE: 'DenyAccess - sub to permanently deny access'
  1522. ' $PAGE
  1523. '
  1524. '  NAME    -- DenyAccess
  1525. '
  1526. '  INPUTS  --     PARAMETER                    MEANING
  1527. '
  1528. '  OUTPUTS -- (USER'S RECORD)
  1529. '
  1530. '  PURPOSE -- Permanently resets user's security level when access denied
  1531. '
  1532.      SUB DenyAccess STATIC
  1533.      CALL TPut
  1534.      ZLogonErrorIndex = 5
  1535.      ZSubParm = 6
  1536.      CALL FileLock
  1537.      CALL OpenUser (HighestUserRecord)
  1538.      FIELD 5, 128 AS ZUserRecord$
  1539.      GET 5,ZUserFileIndex
  1540.      MID$(ZUserRecord$,47,2) = MKI$(ZUserSecLevel)
  1541.      PUT 5,ZUserFileIndex
  1542.      ZSubParm = 8
  1543.      CALL FileLock
  1544.      END SUB
  1545. 1396 ' $SUBTITLE: 'TPut -- common routine to write to comm. port'
  1546. ' $PAGE
  1547. '
  1548. '  NAME    -- TPut (TERMINAL PUT)
  1549. '
  1550. '  INPUTS  --     PARAMETER                    MEANING
  1551. '                     ZOutTxt$                 STRING TO WRITE TO THE
  1552. '                                              COMMUNICATIONS PORT
  1553. '                 ZSubParm = 1           SKIP A LINE BEFORE WRITING
  1554. '                                        TO THE COMMUNICATIONS PORT
  1555. '                          = 2           SKIP A LINE BEFORE WRITING
  1556. '                                        TO THE COMMUNICATIONS PORT
  1557. '                                        AND THEN SKIP TWO LINES
  1558. '                                        AFTER WRITING TO THE COMM-
  1559. '                                        UNICATIONS PORT
  1560. '                           = 3          WRITE TO THE COMMUNICATIONS
  1561. '                                        PORT AND THEN SKIP TWO LINES
  1562. '                           = 4          WRITE TO THE COMMUNICATIONS
  1563. '                                        PORT WITHOUT A CR/LF
  1564. '                           = 5          WRITE TO THE COMMUNICATIONS
  1565. '                                        PORT WITH A CR/LF
  1566. '                           = 6          RESET EVERYTHING FOR INPUT STRING
  1567. '                           = 7          RE-ENTRY AFTER HANDLING A
  1568. '                                        FUNCTION KEY
  1569. '
  1570. '  OUTPUTS --  ZSubParm = -1 Carrier HAS BEEN DROPPED
  1571. '              ZFunctionKey        <>  0 FUNCTION KEY PRESSED
  1572. '
  1573. '  PURPOSE --  Common output routine for RBBS-PC to the
  1574. '              communications port (terminal put)
  1575.       SUB TPut STATIC
  1576.       IF ZSubParm <> 7 THEN _
  1577.          Parm = ZSubParm
  1578.       ON ZSubParm GOTO 1398,1399,1400,1403,1405,1450,1411
  1579. '
  1580. '
  1581. ' *  COMMON OUTPUT ROUTINE
  1582. '
  1583. '
  1584. 1398 CALL SkipLine (1)
  1585.      GOTO 1405
  1586. 1399 CALL SkipLine (1)
  1587. 1400 ZCR = 1
  1588. 1403 ZCR = ZCR + 1
  1589. 1405 ZRet = ZFalse
  1590.      IF ZWasCM THEN _
  1591.         GOTO 1435
  1592. 1410 CALL FindFKey
  1593.      IF ZSubParm < 0 THEN _
  1594.         EXIT SUB
  1595. 1411 ZWasY$ = ZKeyPressed$
  1596.      ZSubParm = Parm
  1597.      IF ZLocalUser THEN _
  1598.         GOTO 1430
  1599.      CALL EofComm (Char)
  1600.      IF Char = -1 THEN _
  1601.         CALL CheckCarrier : _
  1602.         IF ZSubParm = -1 THEN _
  1603.            EXIT SUB _
  1604.         ELSE GOTO 1430
  1605.      CALL GetCom(ZWasY$)
  1606. 1425 IF ZSubParm = -1 THEN _
  1607.         EXIT SUB
  1608. 1430 IF ZWasY$ = "" THEN _
  1609.         GOTO 1435
  1610.      ON INSTR(ZInterrupOn$,ZWasY$) GOTO 1434,1434,1473,1475,1433
  1611.      GOSUB 1476
  1612.      GOTO 1435
  1613. 1433 GOSUB 1476
  1614.      IF ASC(RIGHT$(ZCommPortStack$,2)) = 13 OR _
  1615.         ZStopInterrupts THEN _
  1616.         GOTO 1435  'stack if series of [ENTER]s or no previous stack
  1617.      GOTO 1471
  1618. 1434 IF ZStopInterrupts THEN _
  1619.         GOTO 1435
  1620.      ZCommPortStack$ = ""
  1621.      GOTO 1471
  1622. 1435 LOCATE ,,1
  1623.      CALL LPrnt (ZOutTxt$,0)
  1624. 1437 IF ZUpperCase THEN _
  1625.         IF ZWasGR <> 2 THEN _
  1626.            CALL AllCaps (ZOutTxt$)
  1627.      CALL PutCom (ZOutTxt$)
  1628. 1450 IF ZCR <> 1 THEN _
  1629.         CALL SkipLine (1) _
  1630.      ELSE IF ZCR > 1 THEN _
  1631.              CALL SkipLine (1)
  1632. 1470 ZCR = 0
  1633.      EXIT SUB
  1634. 1471 CALL SkipLine (1)
  1635.      ZStopInterrupts = ZFalse
  1636.      ZRet = ZTrue
  1637.      ZNo = ZTrue
  1638.      ZNonStop = ZFalse
  1639.      GOTO 1470
  1640. 1473 ZXOffEd = ZTrue
  1641.      GOTO 1410
  1642. 1475 ZXOffEd = ZFalse
  1643.      GOTO 1410
  1644. 1476 IF ASC(ZWasY$) < 127 THEN _
  1645.         ZCommPortStack$ = ZCommPortStack$ + ZWasY$
  1646.      RETURN
  1647.      END SUB
  1648. 1478 ' $SUBTITLE: 'QuickTPut - subroutine to quickly write to terminal'
  1649. ' $PAGE
  1650. '
  1651. '  NAME    -- QuickTPut
  1652. '
  1653. '  INPUTS  -- PARAMETER             MEANING
  1654. '             Strng$             STRING TO WRITE OUT
  1655. '             NumReturns         NUMBER OF CARRIAGE RETURNS
  1656. '
  1657. '  OUTPUTS -- NONE
  1658. '
  1659. '  PURPOSE -- Subroutine to quickly write to the terminal.  This is
  1660. '             different from "TPut" in the things it doesn't do:
  1661. '                A.) No function key check,
  1662. '                B.) No conversion to upper case,
  1663. '                C.) No check for carrier present
  1664. '                D.) No check for imbedded carriage return in "Strng$"
  1665. '                E.) No support for XON/XOff
  1666. '
  1667.       SUB QuickTPut (Strng$,NumReturns) STATIC
  1668.       IF ZSubParm < 0 THEN _
  1669.          EXIT SUB
  1670.       IF ZUseTPut THEN _
  1671.          ZOutTxt$ = Strng$ : _
  1672.          ZSubParm = 4 : _
  1673.          CALL TPut : _
  1674.          CALL SkipLine (NumReturns) : _
  1675.          EXIT SUB
  1676.       CALL PutCom (Strng$)
  1677.       LOCATE ,,1
  1678.       CALL LPrnt (Strng$,0)
  1679.       CALL SkipLine (NumReturns)
  1680.       END SUB
  1681.       SUB QuickTPut1 (Strng$) STATIC
  1682.       CALL QuickTPut (Strng$,1)
  1683.       END SUB
  1684. 1480 ' $SUBTITLE: 'LPrnt    - subroutine to write to display'
  1685. ' $PAGE
  1686. '
  1687. '  NAME    -- LPrnt
  1688. '
  1689. '  INPUTS  -- PARAMETER             MEANING
  1690. '             Strng$        STRING TO WRITE OUT
  1691. '             NumReturns   NUMBER OF CARRIAGE RETURNS
  1692. '
  1693. '  OUTPUTS -- NONE
  1694. '
  1695. '  PURPOSE -- Subroutine to write to the display.
  1696. '
  1697.       SUB LPrnt (Strng$,NumReturns) STATIC
  1698.       IF NOT ZSnoop THEN _
  1699.          EXIT SUB
  1700.       CALL PScrn (Strng$)
  1701.       'IF ZVoiceType <> 0 AND ZTalkAll THEN _
  1702.       '   CALL Talk (65,Strng$)
  1703.       IF ZUseBASICWrites THEN _
  1704.          FOR WasI = 1 TO NumReturns : _
  1705.             PRINT : _
  1706.          NEXT : _
  1707.       ELSE FOR WasI = 1 TO NumReturns : _
  1708.               LOCATE ,,1 : _
  1709.               CALL ANSI(ZCrLf$,ZWasCL,ZWasCC) : _
  1710.               LOCATE ZWasCL,ZWasCC : _
  1711.               NEXT
  1712.       END SUB
  1713. 1482 ' $SUBTITLE: 'QuickLPrnt - subroutine to quickly write to display'
  1714. ' $PAGE
  1715. '
  1716. '  NAME    -- QuickLPrnt
  1717. '
  1718. '  INPUTS  -- PARAMETER             MEANING
  1719. '             Strng$        STRING TO WRITE OUT
  1720. '             Num           NUMBER OF CARRIAGE RETURNS
  1721. '
  1722. '  OUTPUTS -- NONE
  1723. '
  1724. '  PURPOSE -- Subroutine to quickly write to the display.
  1725. '             Overwrites, and puts up count
  1726.       SUB QuickLPrnt (Strng$,Num) STATIC
  1727.       IF ZSnoop THEN _
  1728.          LOCATE ,1,1 : _
  1729.          CALL Pscrn (Strng$ + STR$(Num))
  1730.       END SUB
  1731. 1483 ' $SUBTITLE: 'PScrn    - subroutine to print to the screen'
  1732. ' $PAGE
  1733. '
  1734. '  NAME    -- PScrn
  1735. '
  1736. '  INPUTS  -- PARAMETER             MEANING
  1737. '             Strng$        STRING TO WRITE OUT
  1738. '
  1739. '  OUTPUTS -- NONE
  1740. '
  1741. '  PURPOSE -- Writes to local screen regardless of whether you have
  1742. '             carrier.  Assumes have positioned cursor where you want.
  1743. '
  1744.       SUB PScrn (Strng$) STATIC
  1745.       IF Strng$ = "" THEN _
  1746.          EXIT SUB
  1747.       IF ZUseBASICWrites THEN _
  1748.          PRINT Strng$; _
  1749.       ELSE CALL ANSI (Strng$,ZWasCL,ZWasCC) : _
  1750.            LOCATE ZWasCL,ZWasCC
  1751.       END SUB
  1752. 1485 ' $SUBTITLE: 'SkipLine - sub to write a blank line to user'
  1753. ' $PAGE
  1754. '
  1755. '  NAME    -- SkipLine
  1756. '
  1757. '  INPUTS  --   PARAMETER             MEANING
  1758. '               ZLocalUser
  1759. '               ZModemStatusReg
  1760. '               NumReturns
  1761. '               ZReturnLineFeed$
  1762. '               ZSnoop
  1763. '
  1764. '  OUTPUTS -- NONE
  1765. '
  1766. '  PURPOSE -- Skip lines on the user's terminal
  1767. '
  1768.       SUB SkipLine (NumReturns) STATIC
  1769.       FOR WasI=1 TO NumReturns
  1770.           CALL PutCom (ZReturnLineFeed$)
  1771.       NEXT
  1772.       IF NOT ZSnoop THEN _
  1773.          GOTO 1486
  1774.       IF ZUseBASICWrites THEN _
  1775.          FOR WasI = 1 TO NumReturns : _
  1776.             PRINT : _
  1777.          NEXT _
  1778.       ELSE FOR WasI = 1 TO NumReturns : _
  1779.               LOCATE ,,1 : _
  1780.               CALL ANSI(ZCrLf$,ZWasCL,ZWasCC) : _
  1781.               LOCATE ZWasCL,ZWasCC : _
  1782.            NEXT
  1783. 1486  ZLinesPrinted = ZLinesPrinted + NumReturns
  1784.       ZUnitCount = ZUnitCount - ZDisplayAsUnit * NumReturns
  1785.       END SUB
  1786. 1496 ' $SUBTITLE: 'SetCrLf -- sub to set up nulls/lf's for output'
  1787. ' $PAGE
  1788. '
  1789. '  NAME    -- SetCrLf
  1790. '
  1791. '  INPUTS  --   PARAMETER          MEANING
  1792. '              ZCarriageReturn$    CARRIAGE RETURN CHARACTER
  1793. '              ZLineFeed$          LINE FEED CHARACTER
  1794. '              ZLineFeeds          LINE FEED Switch
  1795. '              ZNul$                NULL CHARACTER
  1796. '
  1797. '  OUTPUTS -- ZReturnLineFeed$   END-OF-LINE STRING
  1798. '
  1799. '  PURPOSE -- Set up the necessary nulls/line feeds to end
  1800. '             each output to the communications port with.
  1801. '
  1802.       SUB SetCrLf STATIC
  1803.       ZReturnLineFeed$ = _
  1804.          MID$(ZCarriageReturn$,1, - (NOT ZLocalUser)) + _
  1805.          ZNul$ + _
  1806.          MID$(ZLineFeed$,1, - (ZLineFeeds <> 0))
  1807.       END SUB
  1808. 1498 ' $SUBTITLE: 'TGet -- ask a user a question and get reply'
  1809. ' $PAGE
  1810. '
  1811. '  NAME    -- TGet
  1812. '
  1813. '  INPUTS  --    PARAMETER                   MEANING
  1814. '                ZSubParm          = 1  STANDARD ENTRY
  1815. '                                  = 2  ENTRY AFTER A FUNCTION KEY
  1816. '                                         HAS BEEN HANDLED
  1817. '                                  = 3  ENTRY AFTER STACKED COMMAND
  1818. '             ZOutTxt$                        STRING TO WRITE TO THE
  1819. '                                       COMMUNICATIONS PORT
  1820. '             ZHidden                    IF THIS IS TRUE THEN ECHO
  1821. '                                       '.' INSTEAD OF ACTUAL
  1822. '                                       CHARACTER ENTERED.
  1823. '             ZForceKeyboard            IF TRUE, STACKED INPUT
  1824. '                                       IS BYPASSED AND KEYBOARD
  1825. '                                       INPUT IS READ.
  1826. '
  1827. '  OUTPUTS -- ZSubParm = -1 Carrier HAS BEEN DROPPED
  1828. '             ZUserIn$                  STRING THAT WAS ENTERED
  1829. '             ZWasQ                     NUMBER OF PARAMETERES THAT
  1830. '                                       WERE ENTERED WHICH WHERE
  1831. '                                       SEPARATED BY A SEMICOLON
  1832. '             ZUserIn$()                STRING MATRIX WITH EACH
  1833. '                                       ITEM CONTAIN THE STRING
  1834. '                                       THAT WAS ENTERED BETWEEN
  1835. '                                       SEMICOLONS.
  1836. '             ZFunctionKey        <>  0 FUNCTION KEY PRESSED
  1837. '             ZYes                      Reply IS "Y" OR "YES"
  1838. '             ZNo                       Reply IS "N" OR "NO"
  1839. '             ZNonStop                  Reply IS "NS" OR "ns"
  1840. '             ZKillMessage              Reply IS "K"
  1841. '             ZReply                    Reply IS "RE"
  1842. '
  1843. '  SUBROUTINE PURPOSE --  COMMON ROUTINE TO ASK A USER A QUESTION
  1844. '
  1845.      SUB TGet STATIC
  1846.      MacroIndex = ZForceKeyboard
  1847.      ON ZSubParm GOTO 1500,1538,1625
  1848. '
  1849. '
  1850. ' *  COMMON INPUT ROUTINE
  1851. '
  1852. '
  1853. 1500 CALL Carrier
  1854.      IF ZSubParm = -1 THEN _
  1855.         EXIT SUB
  1856.      ZLinesPrinted = 0
  1857.      ZDisplayAsUnit = ZFalse
  1858.      InStack = ZFalse
  1859.      GOSUB 1580
  1860.      ZWasA = 0
  1861.      ZWasB = 0
  1862.      ZWasC = 0
  1863.      ZWasQ = 1
  1864.      ZStoreParseAt = 1
  1865.      Parm = 0
  1866.      ZYes = ZFalse
  1867.      ZUserIn$ = ""
  1868.      SleepWarn = ZTrue
  1869.      ZNo = ZFalse
  1870.      ZNonStop = (ZPageLength < 1)
  1871.      IF ZOutTxt$ = "" THEN _
  1872.         GOTO 1525
  1873.      IF ZHidden THEN _
  1874.         ZOutTxt$ = ZOutTxt$ + " (dots echo)"
  1875.      IF (NOT ZVerifying) OR HoldA$ = "" THEN _
  1876.         CALL ColorPrompt (ZOutTxt$) : _
  1877.         ZOutTxt$ = ZOutTxt$ + _
  1878.              MID$("? !  ",2*ZTurboKey+1,2) : _
  1879.         HoldA$ = ZOutTxt$ _
  1880.      ELSE ZOutTxt$ = HoldA$
  1881.      ZSubParm = 4
  1882.      StopSave = ZStopInterrupts
  1883.      ZStopInterrupts = ZTrue
  1884.      CALL TPut
  1885.      ZStopInterrupts = StopSave
  1886.      IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
  1887.         EXIT SUB
  1888. 1523 IF ZPromptBell THEN _
  1889.         IF ZLocalUser THEN _
  1890.            BEEP_
  1891.         ELSE CALL PutCom(ZBellRinger$)
  1892. 1525 CALL Carrier
  1893.      IF ZSubParm = -1 THEN _
  1894.         EXIT SUB
  1895.      IF LEN(ZCommPortStack$) > 0 THEN _
  1896.         InStack = ZTrue : _
  1897.         WasX = INSTR(ZCommPortStack$,ZCarriageReturn$) : _
  1898.         IF WasX > 0 THEN _
  1899.            ZOutTxt$ = LEFT$(ZCommPortStack$,WasX-1) : _
  1900.            ZCommPortStack$ = RIGHT$(ZCommPortStack$,LEN(ZCommPortStack$)-WasX) : _
  1901.            GOTO 1534 _
  1902.         ELSE ZWasY$ = LEFT$(ZCommPortStack$,1) : _
  1903.              ZCommPortStack$ = RIGHT$(ZCommPortStack$,LEN(ZCommPortStack$)-1) : _
  1904.              GOTO 1541
  1905.      IF (ZForceKeyboard OR (NOT ZMacroActive) OR (ZMacroSave > 0)) THEN _
  1906.         GOTO 1536
  1907. '
  1908. ' *** MACRO PROCESSING
  1909. '
  1910. 1526 CALL ReadMacro
  1911.      IF ZMacroSave > 0 THEN _
  1912.         GOTO 1500
  1913.      IF NOT ZMacroActive THEN _
  1914.         ZWasQ = 0 : _
  1915.         ZLastIndex = 0 : _
  1916.         EXIT SUB
  1917.      IF (ZDistantTGet > 0 ) OR (ZMacroTemplate$ <> "") THEN _
  1918.         GOTO 1536
  1919. 1534 ZUserIn$ = ZOutTxt$   ' Not Macro command - pass to normal processing
  1920.      IF ZMacroEcho THEN _
  1921.         ZSubParm = 4 : _
  1922.         CALL TPut
  1923.      WasX$ = ZCarriageReturn$
  1924.      GOTO 1547
  1925. 1536 IF ZLocalUser THEN _  'Pe 02/05/90  was GOTO 1537
  1926.        CALL FindFKey: _
  1927.        IF ZSubParm < 0 THEN _
  1928.           EXIT SUB _
  1929.        ELSE GOTO 1538
  1930.      CALL EofComm (Char)
  1931.      IF Char <> -1 THEN _
  1932.         CALL GetCom(ZWasY$) : _
  1933.         IF ZSubParm = -1 THEN _
  1934.            EXIT SUB _
  1935.         ELSE GOTO 1541
  1936. 1537 CALL CheckTime(ZAutoLogoff!, TempElapsed!, 3)
  1937.      IF TempElapsed! < 30 THEN _
  1938.         IF TempElapsed! <= 0 THEN _
  1939.            CALL UpdtCalr ("Sleep disconnect",1) : _
  1940.            ZSubParm = -1 : _
  1941.            ZNo = ZTrue : _
  1942.            ZSleepDisconnect = ZTrue : _
  1943.            EXIT SUB _
  1944.         ELSE IF SleepWarn THEN _
  1945.                 SleepWarn = ZFalse : _
  1946.                 ZOutTxt$ = "Logging you Off if you do not respond in 30 seconds!" : _
  1947.                 CALL RingCaller
  1948.      CALL FindFKey
  1949.      IF ZSubParm < 0 THEN _
  1950.         EXIT SUB
  1951. 1538 ZWasY$ = ZKeyPressed$
  1952.      IF ZWasY$ <> "" THEN _
  1953.         GOTO 1545
  1954.      SendRemote = ZTrue
  1955.      CALL GoIdle
  1956.      GOTO 1525
  1957. 1541 SendRemote = ZRemoteEcho
  1958.      IF ZTestParity THEN _
  1959.         GOTO 1542
  1960.      IF ZWasY$ = CHR$(127) THEN _
  1961.         GOTO 1635
  1962.      GOTO 1545
  1963. 1542 IF ZWasY$ = "" THEN _
  1964.         ZWasY$ = " "
  1965.      IF ASC(ZWasY$) = 141 THEN _
  1966.         OUT ZLineCntlReg,&H1A : _
  1967.         ZEightBit = ZFalse : _
  1968.         ZTestParity = ZFalse : _
  1969.         ZWasGR = ZFalse
  1970.      ZWasY$ = CHR$(ASC(ZWasY$) AND 127)
  1971. 1545 WasX$ = ZWasY$
  1972.      IF INSTR(ZLineEditChk$,ZWasY$) > 5 _
  1973.         GOTO 1635
  1974.      IF ZWasY$ < " " AND ZWasY$ <> ZCarriageReturn$ THEN _
  1975.         GOTO 1525
  1976.      IF ZWasY$ = "^" THEN _
  1977.         GOTO 1525
  1978.      IF ZWasY$ = ZCarriageReturn$ THEN _
  1979.         GOTO 1547 _
  1980.      ELSE GOSUB 1550
  1981.      IF ZTurboKey < 1 THEN _
  1982.         GOTO 1546
  1983.      IF ZWasY$ = " " THEN _
  1984.         ZWasY$ = ""
  1985.      IF ZWasY$ <> "/" THEN _
  1986.         ZUserIn$ = ZWasY$ : _
  1987.         ZWasY$ = ZCarriageReturn$ : _
  1988.         WasX$ = ZWasY$ : _
  1989.         GOTO 1547
  1990.      ZTurboKey = 0
  1991.      GOTO 1525
  1992. 1546 IF LEN(ZUserIn$) => 512 THEN _
  1993.         ZOutTxt$ = "Input too long!" : _
  1994.         ZSubParm = 5 : _
  1995.         CALL TPut : _
  1996.         IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
  1997.            EXIT SUB _
  1998.         ELSE GOTO 1500
  1999.      ZUserIn$ = ZUserIn$ + _
  2000.           ZWasY$
  2001.      GOTO 1525
  2002. 1547 ZTurboKey = ZFalse          ' Carriage Return Handler
  2003.      ZHidden = ZFalse
  2004.      IF ZNoAdvance THEN _
  2005.         ZNoAdvance = ZFalse : _
  2006.         GOTO 1575 _
  2007.      ELSE CALL LPrnt (ZCrLf$,0) : _
  2008.           GOSUB 1551 : _
  2009.           GOTO 1570
  2010. 1550 IF ZLogonActive THEN _
  2011.         IF (ZWasY$ = " " OR ZWasY$ = ";") AND _
  2012.            RIGHT$(ZUserIn$,1) <> " " AND RIGHT$(ZUserIn$,1) <> ";" THEN _
  2013.               Parm = Parm + 1 : _
  2014.               ZLogonActive = (Parm < 3) : _
  2015.               ZHidden = (Parm = 2) : _
  2016.               CALL LPrnt(WasX$,0) : _
  2017.               GOTO 1551
  2018.      IF ZHidden AND (WasX$ <> " ") THEN _
  2019.         WasX$ = "."
  2020.      CALL LPrnt(WasX$,0)
  2021. 1551 IF NOT SendRemote THEN _
  2022.         RETURN
  2023.      IF ZHidden AND (WasX$ <> " ") THEN _
  2024.         WasX$ = "."
  2025. 1553 CALL PutCom (WasX$)
  2026.      RETURN
  2027. 1570 IF SendRemote THEN _
  2028.         IF ZLineFeeds THEN _
  2029.            CALL PutCom (ZLineFeed$)
  2030. 1575 IF LEN(ZUserIn$) > 4000 THEN _
  2031.         ZOutTxt$ = "Try again, " + _
  2032.              ZFirstName$ : _
  2033.         ZSubParm = 5 : _
  2034.         CALL TPut : _
  2035.         IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
  2036.            EXIT SUB _
  2037.         ELSE GOTO 1500
  2038.      IF ZParseOff THEN _
  2039.         ZParseOff = ZFalse : _
  2040.         GOTO 1620
  2041.      CALL ParseIt
  2042.      IF ZWasQ = 1 THEN _
  2043.         GOTO 1622
  2044.      GOTO 1625
  2045. 1580 ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  2046.      RETURN
  2047. 1620 ZUserIn$(ZStoreParseAt) = ZUserIn$
  2048.      ZWasQ = 1
  2049. 1622 IF ZUserIn$ = "" THEN _
  2050.         ZWasQ = 0 : _
  2051.         ZHidden = ZFalse : _
  2052.         GOTO 1628
  2053. 1625 IF LEN(ZUserIn$) < 4 THEN _
  2054.         WasX$ = LEFT$(ZUserIn$,3): _
  2055.         CALL AllCaps (WasX$) : _
  2056.         IF WasX$ = "Y" OR WasX$ = "YES" THEN _
  2057.            ZYes = ZTrue _
  2058.         ELSE IF WasX$ = "N" OR WasX$ = "NO" OR WasX$ = "A" THEN _
  2059.                 ZNo = ZTrue _
  2060.              ELSE IF WasX$ = "RE" THEN _
  2061.                      ZReply = ZTrue : _
  2062.                      GOTO 1628 _
  2063.                   ELSE IF WasX$ = "K" THEN _
  2064.                           ZKillMessage = ZTrue : _
  2065.                           GOTO 1628
  2066.      ZHidden = ZFalse
  2067. '     ZWasX$ = ""           'ANSIEd       ' Bh 110790
  2068. 1628 CALL VerifyAns
  2069.      IF NOT ZOK THEN _
  2070.         CALL QuickTPut1 ("Invalid answer <" + ZUserIn$(1) + ">") : _
  2071.         GOTO 1500
  2072.      HoldA$ = ""
  2073.      ZForceKeyboard = ZFalse
  2074.      IF ZMacroSave > 0 THEN _
  2075.         ZGSRAra$(ZMacroSave) = ZUserIn$ : _
  2076.         ZMacroSave = 0 : _
  2077.         GOTO 1632
  2078.      IF (ZDistantTGet > 0) OR (ZMacroTemplate$ <> "") THEN _
  2079.         CALL WipeLine (38) : _
  2080.         IF NOT ZNo THEN _
  2081.            GOTO 1632 _
  2082.         ELSE ZWasQ = 0 : _
  2083.              ZMacroTemplate$ = "" : _
  2084.              ZDistantTGet = 0 : _
  2085.              ZNo = ZFalse : _
  2086.              GOTO 1633
  2087.      IF ZMacroActive THEN _
  2088.         ZLastIndex = ZWasQ : _
  2089.         FirstIndex = 1: _
  2090.         ZMacroActive = NOT EOF(6) : _
  2091.         EXIT SUB
  2092.      IF ZAnsIndex > 255 OR ((NOT InStack) AND INSTR(ZUserIn$,".") > 0) THEN _
  2093.         EXIT SUB
  2094.      IF MacroIndex THEN _
  2095.         MacroIndex = 1 _
  2096.      ELSE MacroIndex = ZAnsIndex
  2097.      CALL NoPath (ZUserIn$(MacroIndex),Found)
  2098.      IF Found THEN _
  2099.         EXIT SUB
  2100.      CALL CheckMacro (ZUserIn$(MacroIndex),Found)
  2101.      IF Found THEN _
  2102.         ZStoreParseAt = ZAnsIndex : _
  2103.         GOTO 1525
  2104.      EXIT SUB
  2105. 1632 ZUserIn$ = ""
  2106.      ZForceKeyboard = ZFalse
  2107. 1633 GOSUB 1580
  2108.      ZWasQ = 1
  2109.      GOTO 1525
  2110. 1635 IF LEN(ZUserIn$) = 0 THEN _
  2111.         GOTO 1525
  2112.      IF ZLogonActive THEN _
  2113.         IF INSTR(" ;",RIGHT$(ZUserIn$,1)) > 0 THEN _
  2114.            Parm = Parm - 1
  2115.      ZUserIn$ = LEFT$(ZUserIn$,LEN(ZUserIn$)-1)
  2116.      CALL LPrnt(ZLocalBksp$,0)
  2117.      IF SendRemote THEN _
  2118.         CALL PutCom(ZBackSpace$)
  2119.      GOTO 1525
  2120.      END SUB
  2121. 1636 ' $SUBTITLE: 'RingCaller - sub to use sound + screen emphasis'
  2122. ' $PAGE
  2123. '
  2124. '  NAME    -- RingCaller
  2125. '
  2126. '  INPUTS  --     PARAMETER                    MEANING
  2127. '                 ZOutTxt$                           STRING TO EMPHASIZE
  2128. '
  2129. '  OUTPUTS --  none
  2130. '
  2131. '  PURPOSE --  Rings the users bell before and after string
  2132. '              (but not snooping sysop) and adds emphasis around
  2133. '              message sent.
  2134. '
  2135.      SUB RingCaller STATIC
  2136.      WasX$ = LEFT$(ZBellRinger$,-ZLocalUser)
  2137.      CALL PutCom (ZBellRinger$)
  2138.      CALL LPrnt (WasX$,0)
  2139.      ZSubParm = 2
  2140.      ZOutTxt$ = ZEmphasizeOn$ + ZOutTxt$ + ZEmphasizeOff$
  2141.      CALL TPut
  2142.      CALL PutCom (ZBellRinger$)
  2143.      CALL LPrnt (WasX$,0)
  2144.      END SUB
  2145. 1637 ' $SUBTITLE: 'ParseIt - subroutine to parse a string'
  2146. ' $PAGE
  2147. '
  2148. '  NAME    -- ParseIt
  2149. '
  2150. '  INPUTS  --     PARAMETER                    MEANING
  2151. '                 ZUserIn$                     STRING TO PARSE
  2152. '
  2153. '  OUTPUTS --  ZWasQ                           NUMBER PARSED
  2154. '              ZUserIn$()                      PARSED STRINGS
  2155. '
  2156. '  PURPOSE --  To parse a string into pieces.  Uses semicolon
  2157. '              if exists, otherwise space, otherwise comma
  2158. '
  2159.      SUB ParseIt STATIC
  2160.      ZWasA = INSTR(ZUserIn$,";")
  2161.      IF ZWasA > 0 THEN _
  2162.         ParseChar$ = ";" _
  2163.      ELSE IF ZUserIn$ <> SPACE$(LEN(ZUserIn$)) THEN _
  2164.              CALL Trim (ZUserIn$) : _
  2165.              WasX$ = ZUserIn$ : _
  2166.              ZWasA = INSTR(ZUserIn$,"  ") : _
  2167.              WHILE ZWasA > 0 : _
  2168.                 ZUserIn$ = LEFT$(ZUserIn$,ZWasA - 1) + _
  2169.                      MID$(ZUserIn$,ZWasA + 1) : _
  2170.                 ZWasA = INSTR(ZWasA,ZUserIn$,"  ") : _
  2171.              WEND : _
  2172.              ZWasA = INSTR(ZUserIn$," ") : _
  2173.              IF ZWasA > 1 THEN _
  2174.                 ParseChar$ = " " _
  2175.              ELSE ZWasA = INSTR(ZUserIn$,",") : _
  2176.                   ParseChar$ = ","
  2177.      IF ZWasA > 1 THEN _
  2178.         GOTO 1639
  2179.      ZWasDF$ = ZUserIn$
  2180.      CALL AllCaps (ZWasDF$)
  2181.      IF ZWasDF$ = "NS" THEN _
  2182.          ZUserIn$ = "C" : _
  2183.          ZNonStop = ZTrue
  2184.      ZUserIn$(ZStoreParseAt) = ZUserIn$
  2185.      ZNonStop = ZNonStop OR (ZWasDF$ = "C" AND NOT ZStackC)
  2186.      GOTO 1642
  2187. 1639 ZUserIn$(ZStoreParseAt) = LEFT$(ZUserIn$,ZWasA - 1)
  2188.      ZWasA = ZWasA + 1
  2189.      ZEOL = ZFalse
  2190. 1640 ZWasB = INSTR(ZWasA,ZUserIn$,ParseChar$)
  2191.      ZWasC = ZWasB-ZWasA
  2192.      IF ZWasC < 1 THEN _
  2193.         ZEOL = ZTrue : _
  2194.         ZWasC = 128
  2195.      ZWasDF$ = MID$(ZUserIn$,ZWasA,ZWasC)
  2196.      IF ZWasDF$ <> "" THEN _
  2197.         ZWasQ = ZWasQ + 1 : _
  2198.         ZStoreParseAt = ZStoreParseAt + 1 : _
  2199.         ZUserIn$(ZStoreParseAt) = ZWasDF$ : _
  2200.         CALL AllCaps(ZWasDF$) : _
  2201.         WasX = INSTR(";NS;/G;C;",";"+ZWasDF$+";") : _
  2202.         IF WasX > 0 THEN _
  2203.            ZNonStop = ZNonStop OR (WasX = 1) OR (WasX = 7 AND NOT ZStackC) : _
  2204.            ZAutoLogoffReq = ZAutoLogoffReq OR (WasX = 4) : _
  2205.            IF ZWasQ > 0 AND WasX < 7 THEN _
  2206.               ZWasQ = ZWasQ - 1 : _
  2207.               ZStoreParseAt = ZStoreParseAt - 1
  2208.      IF NOT ZEOL AND ZWasQ < 50 THEN _
  2209.         ZWasA = ZWasB + 1 : _
  2210.         GOTO 1640
  2211.      IF ParseChar$ <> ";" THEN _
  2212.         ZUserIn$ = WasX$
  2213. 1642 ZStackC = ZFalse
  2214.      END SUB
  2215. 1650 ' $SUBTITLE: 'PopCmdStack - prompt for value with command stack check '
  2216.      SUB PopCmdStack STATIC
  2217.      CALL CheckCarrier
  2218.      IF ZSubParm = -1 THEN _
  2219.         ZLastIndex = 0 : _
  2220.         ZWasQ = 0 : _
  2221.         EXIT SUB
  2222.      ZWasQ = 1
  2223. 1651 IF ZAnsIndex < ZLastIndex THEN _
  2224.         ZAnsIndex = ZAnsIndex + 1 : _
  2225.         ZUserIn$ = ZUserIn$(ZAnsIndex) : _
  2226.         IF (NOT ZStackC) AND ZAnsIndex > 1 AND INSTR("Cc",ZUserIn$) > 0 AND LEN(ZUserIn$) = 1 THEN _
  2227.            GOTO 1651 _
  2228.         ELSE ZSubParm = 3 : _
  2229.              CALL TGet : _
  2230.              GOTO 1652
  2231.      ZLastIndex = 0
  2232.      ZAnsIndex = 1
  2233.      ZSubParm = 1
  2234.      ZSearchingAll = ZFalse
  2235.      CALL TGet
  2236.      ZLastIndex = ZWasQ
  2237. 1652 IF ZStoreParseAt > ZLastIndex THEN _
  2238.         IF ZLastIndex > 0 THEN _
  2239.            ZLastIndex = ZStoreParseAt
  2240.      ZStackC = ZFalse
  2241.      ZParseOff = ZFalse
  2242.      END SUB
  2243. 1654 ' $SUBTITLE: 'SetBaud - sub to set the baud rate in the RS232'
  2244. ' $PAGE
  2245. '
  2246. '  NAME    -- SetBaud
  2247. '
  2248. '  INPUTS  --     PARAMETER                    MEANING
  2249. '             ZBaudRateDivisor   NUMBER TO DIVIDE THE 8250 CHIP'S
  2250. '                                 PROGRAMABLE CLOCK TO ADJUST THE
  2251. '                                 BAUD RATE TO THE USER'S BAUD
  2252. '                                 RATE (INDEPENDENT OF THE BAUD
  2253. '                                 RATE USED TO OPEN THE COMM. PORT)
  2254. '
  2255. '        DESIRED BAUD        DIVISIOR (DECIMAL) TO OBTAIN DESIRED BAUD RATE
  2256. '            RATE              PCjr         PC AND XT
  2257. '              50             2237             2304
  2258. '              75             1491             1536
  2259. '             110             1017             1047
  2260. '             134.5            832              857
  2261. '             150              746              768
  2262. '             300              373              384
  2263. '             600              186              192
  2264. '            1200               93               96
  2265. '            1800               62               64
  2266. '            2000               56               58
  2267. '            2400               47               48
  2268. '            3600               31               32
  2269. '            4800               23               24
  2270. '            7200          not available         16
  2271. '            9600          not available         12
  2272. '           19200          not available          6
  2273. '           38400               "                 3
  2274. '  OUTPUTS -- BAUD RATE SET IN THE RS232 INTERFACE
  2275. '
  2276. '  PURPOSE -- To set the baud rate in the RS232 interface
  2277. '             inpependent of the baud rate the communications port
  2278. '             was opened at
  2279. '
  2280.      SUB SetBaud STATIC
  2281.      IF NOT ZKeepInitBaud THEN _
  2282.         ZTalkToModemAt$ =  MID$(ZBaudRates$,(-5 * ZBPS),5) _
  2283.      ELSE ZTalkToModemAt$ = ZModemInitBaud$
  2284.      CALL Trim (ZTalkToModemAt$)
  2285.      IF LEN(ZTalkToModemAt$) < 5 THEN _
  2286.         ZTalkToModemAt$ = SPACE$(4 - LEN(ZTalkToModemAt$)) + _
  2287.                             ZTalkToModemAt$
  2288.      IF ZEightBit THEN_
  2289.         Parity = 2 : _                                    ' No PARITY
  2290.         DataBits = 3 : _                                  ' 8 DATA BITS
  2291.         StopBits = 0 _                                    ' 1 STOP BIT
  2292.      ELSE Parity = 3 : _                                  ' EVEN PARITY
  2293.           DataBits = 2 : _                                ' 7 DATA BITS
  2294.           StopBits = 0                                    ' 1 STOP BIT
  2295.      ComSpeed! = VAL(ZTalkToModemAt$)
  2296.      IF ComSpeed! > 19200 THEN _
  2297.         WasI = 19200 _
  2298.      ELSE WasI = ComSpeed!
  2299.      IF ComSpeed! = 2400 THEN _
  2300.         ZBaudRateDivisor = &H30 + (1 * (ZComputerType = 2)) _
  2301.      ELSE IF ComSpeed! = 1200 THEN _
  2302.         ZBaudRateDivisor = &H60 + (3 * (ZComputerType = 2)) _
  2303.      ELSE IF ComSpeed! = 9600 THEN _
  2304.         ZBaudRateDivisor = &HC _
  2305.      ELSE IF ComSpeed! = 300 THEN _
  2306.         ZBaudRateDivisor = &H180 + (11 * (ZComputerType = 2)) _
  2307.      ELSE IF ComSpeed! = 450 THEN _
  2308.         ZBaudRateDivisor = &H100 + (8 * (ZComputerType = 2)) _
  2309.      ELSE IF ComSpeed! = 4800! THEN _
  2310.         ZBaudRateDivisor = &H18 _
  2311.      ELSE IF ComSpeed! = 19200 THEN _
  2312.         ZBaudRateDivisor = &H6 _
  2313.      ELSE IF ComSpeed! = 38400 THEN _
  2314.         ZBaudRateDivisor = &H3
  2315.      MostSignifByte = FIX (ZBaudRateDivisor / 256)
  2316.      LeastSignifByte = ZBaudRateDivisor - (MostSignifByte * 256)
  2317.      LineCntlStatus = INP(ZLineCntlReg)
  2318.      MSBSave = INP(ZMSB)
  2319.      OUT ZMSB,0
  2320.      OUT ZLineCntlReg,LineCntlStatus OR 128
  2321.      OUT ZLSB,LeastSignifByte
  2322.      OUT ZMSB,MostSignifByte
  2323.      OUT ZLineCntlReg,LineCntlStatus
  2324.      OUT ZMSB,MSBSave
  2325.      END SUB
  2326. 2018 ' $SUBTITLE: 'MessageTo - subroutine to get who a message is to'
  2327. ' $PAGE
  2328. '
  2329. '  NAME    -- MessageTo
  2330. '
  2331. '  INPUTS  --     PARAMETER                    MEANING
  2332. '              HighestUserRecord
  2333. '
  2334. '  OUTPUTS --  MsgTo$              Who message is to
  2335. '              RcvrRecNum         User record # of who to
  2336. '
  2337. '  PURPOSE --  Asks who a message is to and determines if receiver exists
  2338. '
  2339.      SUB MessageTo (HighestUserRecord,MsgTo$,MsgFrom$,RcvrRecNum,Found) STATIC
  2340.      Temp$ = MsgFrom$
  2341.      CALL Trim (Temp$)
  2342. 2020 IF MsgTo$ <> "" THEN _
  2343.         GOTO 2032
  2344.      ZOutTxt$ = "To [A]ll,S)ysop, or Name"
  2345.      CALL SkipLine (1)
  2346.      ZParseOff = ZTrue
  2347.      GOSUB 2033
  2348.      IF LEN(ZUserIn$) > 30 THEN _
  2349.         CALL QuickTPut1 ("30 Char. Max") : _
  2350.         GOTO 2020
  2351. 2030 Found = ZTrue
  2352.      RcvrRecNum = 0
  2353.      IF ZWasQ = 0 THEN _
  2354.         MsgTo$ = "ALL" _
  2355.      ELSE CALL AllCaps (ZUserIn$) : _
  2356.           IF ZUserIn$ = "A" THEN _
  2357.              MsgTo$ = "ALL" : _
  2358.              EXIT SUB _
  2359.           ELSE IF ZUserIn$ = "S" THEN _
  2360.              MsgTo$ = "SYSOP" _
  2361.           ELSE MsgTo$ = ZUserIn$
  2362. 2032 IF MsgTo$ <> "ALL" THEN _
  2363.         IF (LEFT$(MsgTo$,4) <> "ALL " AND ZStartHash = 1) THEN _
  2364.            TempHashValue$ = MsgTo$ : _
  2365.            CALL WhoCheck (TempHashValue$,Found,RcvrRecNum) : _
  2366.            IF NOT Found THEN _
  2367.               ZLastIndex = 0 : _
  2368.               IF NOT ZReply THEN _
  2369.                  ZOutTxt$ = "[R]e-enter name, Q)uit, C)ontinue" : _
  2370.                  ZTurboKey = -ZTurboKeyUser : _
  2371.                  ZLastIndex = 0 : _
  2372.                  GOSUB 2033 : _
  2373.                  ZWasZ$ = ZUserIn$(1) : _
  2374.                  CALL AllCaps (ZWasZ$) : _
  2375.                  IF ZWasZ$ <> "C" THEN _
  2376.                     MsgTo$ = "" : _
  2377.                     IF ZWasZ$ <> "Q" THEN _
  2378.                        GOTO 2020
  2379.      IF MsgTo$ = Temp$ THEN _
  2380.         ZOutTxt$ = "Msg would be From and To Same Person!  Really do this (Y,[N])" : _
  2381.         ZLastIndex = 0 : _
  2382.         GOSUB 2033 : _
  2383.         IF NOT ZYes THEN _
  2384.            MsgTo$ = ""
  2385.      EXIT SUB
  2386. 2033 CALL PopCmdStack
  2387.      IF ZSubParm < 0 THEN _
  2388.         EXIT SUB
  2389.      RETURN
  2390.      END SUB
  2391. 2055 ' $SUBTITLE: 'MsgProt - gets protection wanted for a message'
  2392. ' $PAGE
  2393. '
  2394. '  NAME    -- MsgProt
  2395. '
  2396. '  INPUTS  --     PARAMETER                    MEANING
  2397. '                 MsgTo$
  2398. '                 Found
  2399. '
  2400. '  OUTPUTS --  ZPswd$                Protection desired
  2401. '
  2402. '  PURPOSE --  Sets protection desired for a new message
  2403. '
  2404.      SUB MsgProt (MsgTo$,Found,MsgPswd$) STATIC
  2405.      IF MsgTo$ = "ALL" THEN _
  2406.         GOTO 2090
  2407. 2060 ZOutTxt$ = "Make message [P]ublic, (R)estricted, (H)elp"
  2408. '     IF MsgPswd$ = "^READ^" THEN _
  2409. '        DefaultProt$ = "R" : _
  2410. '        GOTO 2065
  2411. '     IF LEFT$(MsgPswd$,1) = "!" THEN _
  2412. '        DefaultProt$ = "P" _
  2413. '     ELSE _
  2414. '        DefaultProt$ = "U"
  2415. 2065' MID$(ZOutTxt$,INSTR(ZOutTxt$,"("+DefaultProt$+")"),3) = "["+DefaultProt$+"]"
  2416.      ZTurboKey = -ZTurboKeyUser
  2417.      GOSUB 2096
  2418.      IF ZWasQ = 0 THEN _
  2419.         ZUserIn$(ZAnsIndex) = DefaultProt$
  2420.      ZWasZ$ = LEFT$(ZUserIn$(ZAnsIndex),1)
  2421.      CALL AllCaps (ZWasZ$)
  2422.      ON INSTR("PRUH",ZWasZ$) GOTO 2090,2075,2075,2070
  2423.      GOTO 2060
  2424. '
  2425. ' **  DISPLAY MESSAGE PROTECT HELP   *
  2426. '
  2427. 2070 CALL BufFile (ZHelp$(3),WasX)
  2428.      GOTO 2060
  2429. '
  2430. ' ** MAKE MESSAGE READ PROTECTED (ONLY ADDRESSEE AND SYSOP CAN READ IT) *
  2431. '
  2432. 2075 IF MsgTo$ = "ALL" THEN _
  2433.         CALL QuickTPut1 ("Msg to ALL cannot be private") : _
  2434.         GOTO 2060
  2435.      IF ZWasZ$ = "U" THEN _    'Pe 02/05/90
  2436.         GOTO 2088
  2437. 2081 CALL QuickTPut1 ("Sending personal mail to " + MsgTo$)
  2438. 2084 MsgPswd$ = "^READ^"
  2439.      EXIT SUB
  2440. 2085 ZOutTxt$ = "Password"
  2441.      GOSUB 2096
  2442.      IF ZWasQ = 0 THEN _
  2443.         IF LEFT$(MsgPswd$,1) = "!" THEN _
  2444.            MsgPswd$ = MID$(MsgPswd$,2) : _
  2445.            CALL QuickTPut1 ("Password is " + MsgPswd$) : _
  2446.            RETURN _
  2447.         ELSE _
  2448.         GOTO 2085
  2449.      IF LEN(ZUserIn$) > WasL THEN _
  2450.         CALL QuickTPut1 (STR$(WasL) + " Chars. max") : _
  2451.         GOTO 2085
  2452.      IF WasL = 15 AND LEFT$(ZUserIn$,1) = "!" THEN _
  2453.         CALL QuickTPut1 ("Password can't begin with '!'") : _
  2454.         GOTO 2085
  2455.      RETURN
  2456. '
  2457. ' **  PASSWORD PROTECT MESSAGE (USERS WITH PASSWORD AND SYSOP CAN READ) *
  2458. '
  2459. 2088 Call QuickTPut1 ( " Make A Voice call to Your Friend(s)  !!!!") 'Pe 02/06/90
  2460.      Call Delaytime (3)  'Pe 02/06/90
  2461.       GOTO 2060
  2462.      WasL = 14
  2463.      WasA1$ = "!"
  2464.      GOSUB 2085
  2465.      CALL AllCaps (ZUserIn$)
  2466.      GOTO 2092
  2467. '
  2468. ' ** MAKE MESSAGE KILL PROTECTED (ONLY SENDER, ADDRESSEE AND SYSOP CAN KILL) *
  2469. '
  2470. 2090 WasL = 15
  2471.      WasA1$ = ""
  2472.      ZUserIn$ = "^KILL^"
  2473. 2092 MsgPswd$ = WasA1$ + _
  2474.                          ZUserIn$
  2475.      EXIT SUB
  2476. 2093 ZTurboKey = -ZTurboKeyUser
  2477. 2094 ZSubParm = 1
  2478.      CALL TGet
  2479. 2095 IF ZSubParm = -1 THEN _
  2480.         EXIT SUB
  2481.      RETURN
  2482. 2096 CALL PopCmdStack
  2483.      GOTO 2095
  2484.      END SUB
  2485. 2250 ' $SUBTITLE: 'WhoCheck - Checks whether user exists'
  2486. ' $PAGE
  2487. '
  2488. '  NAME    -- WhoCheck
  2489. '
  2490. '  INPUTS  --   PARAMETER                    MEANING
  2491. '              WhoFind$                User to find
  2492. '
  2493. '  OUTPUTS --  WhoFound                Whether user found
  2494. '              UserNumFound           Record # of user
  2495. '
  2496. '  PURPOSE --  Validate that user record exists.  Sysop
  2497. '              counted as found even if lack user record.
  2498. '
  2499.      SUB WhoCheck (WhoFind$,WhoFound,UserNumFound) STATIC
  2500.      UserNumFound = 0
  2501.      IF ZStartHash <> 1 THEN _
  2502.         WhoFound = ZTrue : _
  2503.         EXIT SUB
  2504.      Work128$ = ZUserRecord$
  2505.      WhoFound = ZFalse
  2506.      ToSysop = (INSTR(WhoFind$,"SYSOP") > 0 OR _
  2507.                  INSTR(WhoFind$,ZSysopPswd1$ + " " + ZSysopPswd2$) > 0 )
  2508.      CALL OpenUser (HighestUserRecord)
  2509.      FIELD 5, 128 AS ZUserRecord$
  2510.      IF ToSysop THEN _
  2511.         WasX$ = ZSysopPswd1$ + " " + ZSysopPswd2$ _
  2512.      ELSE WasX$ = WhoFind$
  2513.      IF LEN(WasX$) > 1 THEN _
  2514.         CALL FindUser (WasX$,"",ZStartHash,ZLenHash,_
  2515.                        0,0,HighestUserRecord,WhoFound,_
  2516.                        UserNumFound,ZWasSL)
  2517.      LSET ZUserRecord$ = Work128$
  2518.      IF NOT WhoFound THEN _
  2519.         IF ToSysop THEN _
  2520.            WhoFound = ZTrue _
  2521.     ELSE CALL QuickTPut1 (WhoFind$ + " not active user")
  2522. '    ELSE CALL AliasChk (WhoFind$,WhoFound,UserNumFound) : _       'DGS-ALSMN
  2523. '         IF NOT WhoFound THEN _                                   'DGS-ALSMN
  2524. '            CALL QuickTPut1 (WhoFind$ + " not active user")       'DGS-MNMOD
  2525.      END SUB
  2526. ' $SUBTITLE: 'AliasChk - Checks whether ALIAS exists'
  2527. ' $PAGE
  2528. '
  2529. '  SUBROUTINE NAME    -- AliasChk
  2530. '
  2531. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2532. '                         WhoFind$                    ALIAS to find
  2533. '
  2534. '  OUTPUT PARAMETERS  --  WhoFound                    Whether ALIAS found
  2535. '                         UserNumFound                Record # of User
  2536. '
  2537. '  SUBROUTINE PURPOSE --  Validate that ALIAS exists.  Get User Record
  2538. '
  2539. '2257 SUB AliasChk (WhoFind$,WhoFound,UserNumFound) STATIC         'DGS-ALSMN
  2540. '     CALL BreakFileName (ZMainUserFile$,Drive$,Prefix$,Ext$,ZTrue)    '
  2541. '     DGSTemp = INSTR(ZConfName$," ")                                  '
  2542. '     IF DGSTemp > 0 THEN _                                            '
  2543. '        DGSFileName$ = Drive$ + LEFT$(ZConfName$,DGSTemp-1) + "A.DEF" _ '
  2544. '     ELSE DGSFileName$ = Drive$ + ZConfName$ + "A.DEF"                '
  2545. '     CALL FindIt (DGSFileName$)                                       '
  2546. '     IF NOT ZOK THEN _                                                '
  2547. '        EXIT SUB                                                      '
  2548. '     OPEN "I", 7, DGSFileName$                                        '
  2549. '     DGSAlias$ = ""                                                   '
  2550. '     WHILE DGSAlias$ = "" AND NOT EOF(7)                              '
  2551. '        INPUT #7, DGSUserName$, DGSTempAlias$                         '
  2552. '        IF DGSTempAlias$ = WhoFind$ THEN                              '
  2553. '           DGSAlias$ = DGSUserName$                                   '
  2554. '        END IF                                                        '
  2555. '     WEND                                                             '
  2556. '     CLOSE 7                                                          '
  2557. '     CALL OpenUser (HighestUserRecord)                                '
  2558. '     FIELD 5, 128 AS ZUserRecord$                                     '
  2559. '     CALL FindUser (DGSUserName$,"",ZStartHash,ZLenHash,_             '
  2560. '             0,0,HighestUserRecord,WhoFound,_                         '
  2561. '             UserNumFound,SL)                                         '
  2562. '     END SUB                                                          '
  2563. 2618 ' $SUBTITLE: 'EditALine - Edits a line in a message'
  2564. ' $PAGE
  2565. '
  2566. '  NAME    -- EditALine
  2567. '
  2568. '  INPUTS  --     PARAMETER                    MEANING
  2569. '                 WasL                        Line # to edit
  2570. '
  2571. '  OUTPUTS --  ZOutTxt$(WasL)                 Edited line
  2572. '
  2573. '  PURPOSE --  Edit a line in a message.
  2574. '
  2575.      SUB EditALine (WasL) STATIC
  2576. 2620 ZOutTxt$ = "Line #" + _
  2577.           STR$(WasL) + _
  2578.           " is:" + _
  2579.           ZReturnLineFeed$ + _
  2580.           ZOutTxt$(WasL)
  2581.      ZSubParm = 3
  2582.      CALL TPut
  2583.      GOSUB 2695
  2584.      IF NOT ZExpertUser THEN _
  2585.         CALL QuickTPut1 ("Search & replace")
  2586.      ZOutTxt$ = "Search for" + _
  2587.           ZPressEnterExpert$
  2588.      ZMacroMin = 99
  2589.      ZParseOff = ZTrue
  2590.      ZSubParm = 1
  2591.      GOSUB 2694
  2592.      IF ZWasQ = 0 THEN _
  2593.         EXIT SUB
  2594.      ZWasY$ = LEFT$(ZUserIn$,1)
  2595.      IF ZWasY$ = RIGHT$(ZUserIn$,1) THEN _
  2596.         IF LEN(ZUserIn$) > 2 THEN _
  2597.            WasX = INSTR(2,ZUserIn$,ZWasY$) : _
  2598.            IF WasX < LEN(ZUserIn$) THEN _
  2599.               IF ZWasY$ < "0" OR (ZWasY$ > "9" AND ZWasY$ < "A") THEN _
  2600.                  ZUserIn$ = MID$(ZUserIn$,2,LEN(ZUserIn$)-2) : _
  2601.                  WasX = WasX - 1 : _
  2602.                  GOTO 2622
  2603.      WasX = INSTR(ZUserIn$,";")
  2604. 2622 IF WasX > 0 THEN _
  2605.         WasX$ = LEFT$(ZUserIn$,WasX-1) : _
  2606.         ZWasY$ = RIGHT$(ZUserIn$,LEN(ZUserIn$)-WasX) : _
  2607.         GOTO 2660
  2608.      WasX$ = ZUserIn$
  2609.      ZOutTxt$ = "And replace by"
  2610.      ZParseOff = ZTrue
  2611.      ZSubParm = 1
  2612.      GOSUB 2694
  2613.      ZWasY$ = ZUserIn$
  2614. 2660 WasX = INSTR(1,ZOutTxt$(WasL),WasX$)
  2615.      IF WasX = 0 THEN _
  2616.         CALL QuickTPut1 ("<" + WasX$ + "> not found in line" + STR$(WasL)) : _
  2617.         GOTO 2620
  2618. 2670 ZFF = LEN(WasX$)
  2619.      WasJJ = LEN(ZWasY$)
  2620.      IF ZFF = WasJJ THEN _
  2621.         MID$(ZOutTxt$(WasL),WasX) = ZWasY$ : _
  2622.         GOTO 2620
  2623. 2690 ZWasDF$ = LEFT$(ZOutTxt$(WasL),WasX - 1)
  2624.      ZOutTxt$(WasL) = ZWasDF$ + _
  2625.              ZWasY$ + _
  2626.              MID$(ZOutTxt$(WasL),WasX + ZFF)
  2627.      IF LEN(ZOutTxt$(WasL)) > ZRightMargin THEN _
  2628.         CALL WordWrap (ZRightMargin, ZLinesInMsg, ZOutTxt$())
  2629.      GOTO 2620
  2630. 2694 CALL TGet
  2631. 2695 IF ZSubParm > -1 THEN _
  2632.         RETURN
  2633.      END SUB
  2634. 3700 ' $SUBTITLE: 'LineEdit  - subroutine to produce edited line'
  2635. ' $PAGE
  2636. '
  2637. '  NAME    -- LineEdit
  2638. '
  2639. '  INPUTS  -- PARAMETER             MEANING
  2640. '             ZBackArrow$
  2641. '             ZBackSpace$
  2642. '             ZCarriageReturn$
  2643. '             ZLineFeed$
  2644. '             ZLineMes$          BUFFER SPACE TO USE FOR HOLDING LINE
  2645. '             ZLocalUser
  2646. '             MaxLen             MAXIMUM LENGTH OF STRING TO INPUT
  2647. '             MsgLine            WHERE IN ZOutTxt$() TO PUT THE EDITED LINE
  2648. '             ZRightMargin
  2649. '             ZSnoop
  2650. '             ZStopInterrupts
  2651. '             ZWaitExpired
  2652. '
  2653. '  OUTPUTS -- ZOutTxt$(MsgLine)  EDITED LINE
  2654. '
  2655. '  PURPOSE -- Subroutine to edit a line quickly using a minimum of
  2656. '             string space.
  2657. '
  2658.      SUB LineEdit (MsgLine,MaxLen) STATIC
  2659.      LSET ZLineMes$ = ZOutTxt$(MsgLine)
  2660.      Col = LEN(ZOutTxt$(MsgLine))
  2661.      ZStopInterrupts = ZTrue
  2662.      WasXXX = MaxLen - 3
  2663.      ZWaitExpired = ZFalse
  2664.      GOTO 3782
  2665. 3720 Col = Col + 1
  2666.      ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  2667. 3730 CALL FindFKey
  2668.      IF ZSubParm < 0 THEN _
  2669.         EXIT SUB
  2670.      WasX$ = ZKeyPressed$
  2671.      IF WasX$ = "" THEN _
  2672.         IF ZLocalUser THEN _
  2673.            GOTO 3730 _
  2674.         ELSE GOTO 3732
  2675.      IF WasX$ = ZEscape$ THEN _
  2676.         ZKeyPressed$ = WasX$ : _
  2677.         EXIT SUB
  2678.      SendRemote = ZTrue
  2679.      WasZ = INSTR(ZLineEditChk$,WasX$)
  2680.      IF WasZ < 1 THEN _
  2681.         GOTO 3750 _
  2682.      ELSE IF WasZ > 4 THEN _
  2683.              GOTO 3870
  2684.      IF ZLocalUser THEN _
  2685.         GOTO 3730
  2686. 3732 IF ZCommPortStack$ <> "" THEN _
  2687.         WasX$ = LEFT$(ZCommPortStack$,1) : _
  2688.         ZCommPortStack$ = RIGHT$(ZCommPortStack$,LEN(ZCommPortStack$)-1) : _
  2689.         GOTO 3738
  2690.      CALL EofComm (Char)
  2691.      IF Char <> -1 THEN _
  2692.         GOTO 3736
  2693.      CALL CheckTime(ZAutoLogoff!, TempElapsed!, 1)
  2694.      IF TempElapsed! <=0 THEN _
  2695.         ZWaitExpired = ZTrue : _
  2696.         EXIT SUB
  2697. 3733 CALL Carrier
  2698.      IF ZSubParm THEN _
  2699.         EXIT SUB
  2700.      GOTO 3730
  2701. 3736 ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  2702. 3737 CALL GetCom (WasX$)
  2703. 3738 SendRemote = ZRemoteEcho
  2704. 3740 ON INSTR(ZLineEditChk$,WasX$) GOTO 3730,3730,3730,3730,3870,3870,3870,3870,3870
  2705. 3750 IF SendRemote THEN _
  2706.         CALL PutCom(WasX$)
  2707.      CALL LPrnt (WasX$, 0)
  2708.      IF WasX$ = ZCarriageReturn$ THEN _
  2709.         Col = Col - 1 : _
  2710.         GOTO 3850
  2711. 3770 IF Col > WasXXX THEN _
  2712.         IF WasX$ = " " THEN _
  2713.            CALL SkipLine (1) : _
  2714.            GOTO 3860
  2715. 3780 MID$(ZLineMes$,Col) = WasX$
  2716. 3782 IF Col < MaxLen THEN _
  2717.         GOTO 3720
  2718.      WasZ = Col
  2719. 3800 IF WasZ < 1 THEN _
  2720.         WasZ = Col-1 : _
  2721.         GOTO 3820
  2722.      IF MID$(ZLineMes$,WasZ,1) = " " THEN _
  2723.         GOTO 3820
  2724.      WasZ = WasZ - 1
  2725.      GOTO 3800
  2726. 3820 IF (NOT ZRemoteEcho) AND (NOT ZLocalUser) THEN _
  2727.         CALL SkipLine (1) : _
  2728.         GOTO 3860
  2729.      Col = MaxLen - WasZ
  2730.      IF ZSnoop THEN _
  2731.         IF (POS(0) > Col) AND (Col > 0) THEN _
  2732.            LOCATE ,POS(0)-Col: _
  2733.            CALL LPrnt(STRING$(Col,32),0)
  2734. 3830 IF ZRemoteEcho THEN _
  2735.         CALL PutCom (STRING$(Col,8) + STRING$(Col,32))
  2736. 3840 ZOutTxt$(MsgLine) = LEFT$(ZLineMes$,WasZ)
  2737.      ZOutTxt$(MsgLine + 1) = MID$(ZLineMes$,WasZ + 1,Col)
  2738.      CALL SkipLine (1)
  2739.      GOTO 3891
  2740. 3850 IF SendRemote AND ZLineFeeds THEN _
  2741.         CALL PutCom(ZLineFeed$)
  2742. 3860 ZOutTxt$(MsgLine) = LEFT$(ZLineMes$,Col)
  2743.      GOTO 3891
  2744. 3870 IF Col = 1 THEN _
  2745.         GOTO 3730
  2746.      Col = Col-2
  2747. 3880 CALL LPrnt(ZLocalBksp$,0)
  2748. 3885 IF SendRemote THEN _
  2749.         CALL PutCom (ZBackSpace$)
  2750. 3890 GOTO 3720
  2751. 3891 CALL Carrier
  2752.      END SUB
  2753. 3952 ' $SUBTITLE: 'KillMsg - subroutine to delete messages'
  2754. ' $PAGE
  2755. '
  2756. '  NAME    -- KillMsg
  2757. '
  2758. '  INPUTS  --     PARAMETER                    MEANING
  2759. '              MsgToKill                   MESSAGE NUMBER TO KILL
  2760. '              ActiveMessages              NUMBER ACTIVE MESSAGES
  2761. '
  2762. '  OUTPUTS --  NONE
  2763. '
  2764. '  PURPOSE --  To kill/delete old or unnecessary messages
  2765. '
  2766.      SUB KillMsg (MsgToKill,ActiveMessages,ZconfName$) STATIC   'Pe 02/05/90
  2767. '
  2768.      FIELD #1,128 AS ZMsgRec$
  2769.      WasQX = 1
  2770. 3955 IF WasQX > ActiveMessages THEN _
  2771.         ZOutTxt$ = "No such message #" + _
  2772.              STR$(MsgToKill) : _
  2773.         GOTO 4031
  2774.      IF ZMsgPtr(WasQX,2) = MsgToKill AND MsgToKill => 1 THEN _
  2775.         GOTO 3970
  2776.      WasQX = WasQX + 1
  2777.      GOTO 3955
  2778. 3970 ZSubParm = 3
  2779.      CALL FileLock
  2780.      GET 1,ZMsgPtr(WasQX,1)
  2781.      IF ZUserSecLevel >= ZSecKillAny THEN _
  2782.         GOTO 4030
  2783. 3980 ZWasZ$ = MID$(ZMsgRec$,101,15)
  2784.      CALL Trim (ZWasZ$)
  2785.      IF LEN(ZWasZ$) = 0 THEN _
  2786.         GOTO 4030
  2787. '        CALL MsgNameMatch (MsgUserName$,ZActiveUserName$,6,MsgFromCaller) : _ 'DGS-ALS
  2788. '        CALL MsgNameMatch (MsgUserName$,ZActiveUserName$,37,MsgToCaller) : _ 'DGS-ALS
  2789. 3990 IF ZWasZ$ = "^READ^" OR ZWasZ$ = "^KILL^" THEN _
  2790.         CALL MsgNameMatch (ZActiveUserName$,"",6,MsgFromCaller) : _   'DGS-ALS
  2791.         CALL MsgNameMatch (ZActiveUserName$,"",37,MsgToCaller) : _    'DGS-ALS
  2792.         IF (MsgFromCaller or MsgToCaller) THEN _
  2793.            GOTO 4030 _
  2794.         ELSE ZMsgPswd = ZTrue : _
  2795.              ZAttemptsAllowed = 0 : _
  2796.              ZOutTxt$ = "Only sender & receiver can kill" : _
  2797.              GOTO 4031
  2798. 4000 IF LEFT$(ZWasZ$,1) = "!" THEN _
  2799.         ZWasZ$ = MID$(ZWasZ$,2)
  2800. 4010 ZPswdSave$ = ZWasZ$ + _
  2801.                       SPACE$(15 - LEN(ZWasZ$))
  2802.      ZAttemptsAllowed = 1
  2803.      ZMsgPswd = ZTrue
  2804.      CALL PassWrd
  2805.      IF ZPswdFailed THEN _
  2806.         GOTO 4031
  2807. 4030 MID$(ZMsgRec$,116,1) = ZDeletedMsg$
  2808.      PUT 1,LOC(1)
  2809.      ZSubParm = 4
  2810.      CALL FileLock
  2811.      ZOutTxt$ = "Killed Msg # " + _
  2812.           STR$(MsgToKill)
  2813.      CALL Thread2 (MsgToKill,ActiveMessages,ZConfName$)  'PE 01/12/89
  2814.      CALL UpdtCalr (ZOutTxt$,1)
  2815. 4031 ZSubParm = 5
  2816.      CALL TPut
  2817.      END SUB
  2818. 4554 ' $SUBTITLE: 'SetThread - Sets up the interface for threading'
  2819. ' $PAGE
  2820. '
  2821. '  NAME    -- SetThread
  2822. '
  2823. '  INPUTS  --     PARAMETER                    MEANING
  2824. '                 CurMsgNum                 Current message number
  2825. '                 CurSubj$                  Current message subject
  2826. '
  2827. '  OUTPUTS --  ZUserIn$()                   Search msg by string
  2828. '              ZWasQ                        0 if thread cancelled
  2829. '
  2830. '  PURPOSE --  Find out how the caller wants to thread -
  2831. '              i.e. search messages by matching subject -
  2832. '              forward from current, back from current,
  2833. '              or forward from top of messages
  2834. '
  2835.      SUB SetThread (CurMsgNum,CurSubj$) STATIC
  2836.      IF ZWasQ > 1 THEN _
  2837.         ZWasZ$ = ZUserIn$(2) : _
  2838.         GOTO 4657
  2839. 4656 ZOutTxt$ = "FOLLOW this subject: +)forward, -)back, 1)from origin ([RETURN] to quit)"   ' Bh
  2840.      ZTurboKey = -ZTurboKeyUser
  2841.      ZSubParm = 1
  2842.      CALL TGet
  2843.      IF ZWasQ = 0 OR ZSubParm = -1 THEN _
  2844.         EXIT SUB
  2845.      ZWasZ$ = ZUserIn$(1)
  2846. 4657 ZWasZ$ = LEFT$(ZWasZ$,1)
  2847.      WasX = INSTR("+-1",ZWasZ$)
  2848.      IF WasX = 0 THEN _
  2849.         GOTO 4656
  2850.      ZUserIn$(1) = "R"
  2851.      IF WasX = 1 THEN _
  2852.         CurMsgNum = CurMsgNum + 1 _
  2853.      ELSE IF WasX = 2 THEN _
  2854.              CurMsgNum = CurMsgNum - 1 _
  2855.           ELSE CurMsgNum = 1 : _
  2856.                ZWasZ$ = "+"
  2857.      ZUserIn$(3) = MID$(STR$(CurMsgNum),2) + ZWasZ$
  2858.      IF LEN(CurSubj$) < 4 OR LEFT$(CurSubj$,3) <> "(R)" THEN _
  2859.         ZUserIn$(2) = CurSubj$ _
  2860.      ELSE ZUserIn$(2) = MID$(CurSubj$,4)
  2861.      ZUserIn$(2) = LEFT$(ZUserIn$(2) + "  ",22)
  2862.      ZLastIndex = 3
  2863.      ZAnsIndex = 1
  2864.      ZWasQ = 3
  2865.      END SUB
  2866. 4773 ' $SUBTITLE: 'SysopChat - chat with sysop'
  2867. ' $PAGE
  2868. '
  2869. '  NAME    -- SysopChat
  2870. '
  2871. '  INPUTS  --     PARAMETER                    MEANING
  2872. '  OUTPUTS --  ZWasCM                     True if chat active
  2873. '
  2874. '  PURPOSE --  Lets sysop chat interactively with caller
  2875. '
  2876.      SUB SysopChat STATIC
  2877.      ZWasCM = ZTrue
  2878.      TimeChatStarted! = TIMER
  2879.      ZSubParm = 1
  2880.      CALL Line25
  2881.      ZOutTxt$(2) = ""
  2882. 4775 CALL LineEdit (1,72)
  2883.      IF ZKeyPressed$ = ZEscape$ OR _
  2884.         ZSubParm < 0 THEN _
  2885.         GOTO 4777
  2886.      ZOutTxt$(1) = ""
  2887.      IF ZOutTxt$(2) <> "" THEN _
  2888.         ZOutTxt$ = ZOutTxt$(2) : _
  2889.         ZOutTxt$(1) = ZOutTxt$(2) : _
  2890.         ZOutTxt$(2) = "" _
  2891.      ELSE ZOutTxt$ = ""
  2892.      ZSubParm = 4
  2893.      CALL TPut
  2894.      IF ZSubParm > -1 THEN _
  2895.         GOTO 4775
  2896. 4777 ZWasCM = 0
  2897.      CALL CheckTime(TimeChatStarted!,Elapsed!, 2)
  2898.      ZSecsPerSession! = ZSecsPerSession! + Elapsed!
  2899.      IF NOT ZLocalUser THEN _
  2900.         ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  2901. '     CALL SkipLine(1)                                    'ANSIEd  ' Bh 110790
  2902.      CALL QuickTPut("  Chat ended.  Returning to normal operation",2)
  2903.      END SUB
  2904. 5100 ' $SUBTITLE: 'RemNonAlf - removes non-alpha chars from a string'
  2905. ' $PAGE
  2906. '
  2907. '  NAME    -- RemNonAlf
  2908. '
  2909. '  INPUTS  --     PARAMETER                    MEANING
  2910. '                 Strng$                   String to check
  2911. '                 MinChar                  Remove chars with this
  2912. '                                          ASCII value or lower
  2913. '                 MaxChar                  Remove chars with this
  2914. '                                          ASCII value or higher
  2915. '
  2916. '  OUTPUTS --       Strng$                 String returned
  2917. '  PURPOSE --  CALCULATE THE ELASPED TIME A USER HAS BEEN ON
  2918. '
  2919.      SUB RemNonAlf (Strng$,MinChar,MaxChar) STATIC
  2920.      Last = LEN(Strng$)
  2921.      WasJ = 1
  2922.      WHILE WasJ <= Last
  2923.         WasK = ASC(MID$(Strng$,WasJ))
  2924.         IF WasK > MinChar AND WasK < MaxChar THEN _
  2925.            WasJ = WasJ + 1 _
  2926.         ELSE Strng$ = LEFT$(Strng$,WasJ - 1) + _
  2927.                       RIGHT$(Strng$,Last - WasJ) : _
  2928.              Last = Last - 1
  2929.      WEND
  2930.      END SUB
  2931. 5200 ' $SUBTITLE: 'PageLen - Sets lines per page'
  2932. ' $PAGE
  2933. '
  2934. '  NAME    -- PageLen
  2935. '
  2936. '  INPUTS  --     PARAMETER                    MEANING
  2937. '               ZPageLength              Current page length
  2938. '
  2939. '  OUTPUTS --   ZPageLength              New page length
  2940. '
  2941. '  PURPOSE --  Change default lines per page
  2942. '
  2943.      SUB PageLen STATIC
  2944. 5202 ZOutTxt$ = "CHANGE page length from" + _
  2945.           STR$(ZPageLength) + _
  2946.           " TO (0-255, 0=continuous)"
  2947.      CALL PopCmdStack
  2948.      IF ZWasQ = 0 OR ZSubParm = -1 THEN _
  2949.         CALL QuickTPut1 ("No change") : _
  2950.         EXIT SUB
  2951. 5230 CALL CheckInt (ZUserIn$(ZAnsIndex))
  2952.      IF ZErrCode <> 0 THEN _
  2953.         GOTO 5202
  2954.      IF ZTestedIntValue < 0 OR _
  2955.         ZTestedIntValue > 255 THEN _
  2956.         GOTO 5202
  2957.      ZPageLength = ZTestedIntValue
  2958.      CALL QuickTPut1 ("Page Length Set to" + STR$(ZPageLength))
  2959.      END SUB
  2960. 5507 ' $SUBTITLE: 'BankTime - Allows user to bank session time'
  2961. ' $PAGE
  2962. '  NAME    -- BankTime                          
  2963. '
  2964. '  INPUTS  -- PARAMETER             MEANING
  2965. '             ZBankTime
  2966. '
  2967. '  OUTPUTS -- ZBankTime
  2968. '
  2969. '  PURPOSE -- Allow users to bank session time
  2970.  
  2971. SUB BankTime STATIC                         'SRK030690
  2972.    ZOutTxt$ = "Current TimeBank Account: " +_
  2973.                STR$(ZBankTime) + " minutes."
  2974.    CALL QuickTPut1(ZOutTxt$)
  2975.    CALL TimeRemain(MinsRemaining)
  2976.    ZOutTxt$ = STR$(MinsRemaining) + " mins left this session."
  2977.    CALL QuickTPut1(ZOutTxt$)
  2978.    ZOutTxt$ = "Access The TimeBank (Y,[N])"
  2979.    ZTurboKey = -ZTurboKeyUser
  2980.    ZSubParm = 1
  2981.    CALL TGet
  2982.    IF ZSubParm = -1 OR NOT ZYes THEN _
  2983.        EXIT SUB    
  2984.   
  2985.    IF ZBankTime <= 0 then goto 5510
  2986.   
  2987.      ZOutTxt$ = "(D)eposit or [W]ithdraw minutes "
  2988.      ZTurboKey = -ZTurboKeyUser
  2989.      ZSubParm = 1
  2990.      CALL TGet
  2991.      IF ZSubParm = -1 then EXIT SUB
  2992.      IF MID$(ZUserIn$,1,1) = "D" or MID$(ZUserIn$,1,1) = "d" then_
  2993.         goto 5510
  2994. '
  2995.      TempBankTime = ZBankTime
  2996.      ZOutTxt$ = "How many minutes to withdraw (Maximum = " + STR$(ZBankTime) + " mins.)"
  2997.      ZSubParm = 1
  2998.      CALL TGet
  2999.      IF ZSubParm = -1 or ZwasQ = 0 then EXIT SUB     'Pe 04/01/90
  3000.      withdraw = val(ZUserIn$) 
  3001.      if withdraw > ZBankTime or withdraw < 0 then_
  3002.          withdraw = ZBankTime                        'Pe 04/01/90
  3003.  
  3004. CheckTheTime = ZMinsPerSession + withdraw
  3005.  
  3006. '*****   Debug routine to see what we have in the following variables ***
  3007. '
  3008. 'OutTxt$ = " LimitMinsPerSession = "+STR$(ZLimitMinsPerSession) + " MinsPerSession = "+STR$(ZMinsPerSession) + " CheckTheTime =  " + STR$(CheckTheTime)
  3009. 'CALL QuickTput1 (OutTxt$)
  3010. 'CALL DelayTime (3)
  3011. '
  3012.      IF ZLimitMinsPerSession THEN _
  3013.         IF CheckTheTime > ZLimitMinsPerSession  THEN _
  3014.            ZMinsPerSession = ZLimitMinsPerSession : _
  3015. ZOutTxt$ = "Withdraw NOT available due to external event... NO changes Made" : _
  3016.            CALL RingCaller : _
  3017.           ZBankTime = TempBankTime : _
  3018.         Exit Sub
  3019.  
  3020.  ZSecsPerSession! = ZSecsPerSession! + (withdraw * 60)
  3021.   CALL CheckTime (ZUserLogonTime!, ZSecsUsedSession!, 2)
  3022.    IF ZTimeToDropToDos! = 0 OR _
  3023.      ZOldDate$ = DATE$ THEN _
  3024.     GOTO 5509
  3025.  
  3026.   CALL CheckTime (ZTimeToDropToDos!, HowMuchTimeLeft!, 1)
  3027.    IF (ZSecsPerSession! - ZSecsUsedSession!) > HowMuchTimeLeft! THEN _
  3028.        ZSecsPerSession! = HowMuchTimeLeft! + _
  3029.        ZSecsUsedSession! : _
  3030. ZOutTxt$ = "Withdraw NOT available due to external event...No changes made" : _
  3031.        CALL RingCaller : _ 
  3032.       ZBankTime = TempBankTime : _
  3033.    EXIT SUB
  3034.  
  3035. 5509 ZMinsPerSession = ZMinsPerSession - withdraw
  3036.      ZElapsedTime = ZElapsedTime - withdraw
  3037.      CALL TimeRemain(MinsRemaining)
  3038.      CALL QuickTput1 (STR$(MinsRemaining) + " mins left this session.")
  3039.      ZBankTime = ZBankTime - withdraw      
  3040.      ZGlobalBankTime = ZBankTime             'Pe 03/21/90
  3041.      ZOutTxt$ = " Current Account: " +_
  3042.                STR$(ZBankTime) + " minutes."
  3043.      CALL QuickTPut1(ZOutTxt$)
  3044.      EXIT SUB 
  3045.  
  3046.     
  3047.    5510  ZOutTxt$ = "How many minutes to Deposit (Maximum = " + STR$(MinsRemaining) + " mins )"
  3048.      ZSubParm = 1
  3049.      CALL TGet
  3050.      IF ZSubParm = -1 or ZwasQ = 0 then EXIT SUB  'Pe 04/01/90
  3051.      deposit = val(ZUserIn$)
  3052.      call TimeRemain(MinsRemaining) 
  3053.      If deposit > MinsRemaining then_
  3054.         deposit = MinsRemaining -3
  3055.      if Deposit <= 0 then_
  3056.         Deposit = 0:EXIT SUB
  3057.  
  3058.    ZSecsPerSession! = ZSecsPerSession! - (deposit * 60)     
  3059.    ZMinsPerSession = ZMinsPerSession + deposit
  3060.    ZElapsedTime = ZElapsedTime + deposit
  3061.    CALL TimeRemain(MinsRemaining)
  3062.    CALL QuickTput1 (STR$(MinsRemaining) + " mins left this session.")
  3063.      ZBankTime = ZBankTime + Deposit       
  3064.      ZGlobalBankTime = ZBankTime            'Pe 03/21/90
  3065.      ZOutTxt$ = " Current Account: " +_
  3066.                STR$(ZBankTime) + " minutes."
  3067.      CALL QuickTPut1(ZOutTxt$)
  3068.      EXIT SUB
  3069.   END SUB
  3070. 9140 ' $SUBTITLE: 'GetTime - subroutine to calculate elapsed time'
  3071. ' $PAGE
  3072. '
  3073. '  NAME    -- GetTime
  3074. '
  3075. '  INPUTS  --     PARAMETER                    MEANING
  3076. '                ZTimeLoggedOn$
  3077. '
  3078. '  OUTPUTS --  ZSessionHour               NUMBER OF HOURS ON
  3079. '              ZSessionMin                NUMBER OF MINUTES ON
  3080. '              ZSessionSec                NUMBER OF SECONDS ON
  3081. '
  3082. '  PURPOSE --  Calculate the elapsed time a user has been on
  3083. '
  3084.      SUB GetTime STATIC
  3085.      CALL CheckTime(ZUserLogonTime!, TempElapsed!, 2)
  3086.      ZSessionHour = TempElapsed! / 3600
  3087.      ZSessionMin = (TempElapsed! - ZSessionHour * 3600!) / 60
  3088.      ZSessionSec = TempElapsed! - (ZSessionHour * 3600! + ZSessionMin * 60!)
  3089.      IF ZSessionSec < 0 THEN _
  3090.         ZSessionSec = ZSessionSec + 60 : _
  3091.         ZSessionMin = ZSessionMin - 1
  3092.      IF ZSessionMin < 0 THEN _
  3093.         ZSessionMin = ZSessionMin + 60 : _
  3094.         ZSessionHour = ZSessionHour - 1
  3095.      END SUB
  3096. 9600 ' $SUBTITLE: 'DefaultU - subroutine to update user defauts'
  3097. ' $PAGE
  3098. '
  3099. '  NAME    -- DefaultU
  3100. '
  3101. '  INPUTS  --     PARAMETER                    MEANING
  3102. '             ZAutoDownDesired
  3103. '             ZBoldText$              Ansi bold (0 no, 1 yes)
  3104. '             ZCheckBulletLogon
  3105. '             ZExpertUser
  3106. '             ZWasGR
  3107. '             ZLastMsgRead
  3108. '             ZLineFeeds
  3109. '             ZNulls
  3110. '             ZPageLength
  3111. '             ZPromptBell
  3112. '             ZRegDate$
  3113. '             ZReqQuesAnswered
  3114. '             ZRightMargin
  3115. '             ZSkipFilesLogon
  3116. '             ZTimesLoggedOn
  3117. '             ZUpperCase
  3118. '             ZUserOption$
  3119. '             ZUserTextColor          Ansi of color (31-37)
  3120. '             ZUserXferDefault$
  3121. '
  3122. '  OUTPUTS--  USER.OPTONS$
  3123. '
  3124. '  PURPOSE --  To update the user's record with their options.
  3125. '  Meaning of graphics preference stored is as follows: where # is
  3126. '  value stored for the color.  E.g. if graphics perference for text
  3127. '  files is color, and preference for normal text is light yellow,
  3128. '  graphics preference stored is 38.  Colors are Red, Green, Yellow,
  3129. '  Blue, Purple, Cyan, and White.
  3130. '
  3131. '             normal                  bold
  3132. ' Graphics R  G  Y  B  P  C  W    R  G  Y  B  P  C  W
  3133. '   none  30 33 36 39 42 45 48 | 51 54 57 60 63 66 69
  3134. '   ansi  31 34 37 40 43 46 49 | 52 55 58 61 64 67 70
  3135. '  color  32 35 38 41 44 47 50 | 53 56 59 62 65 68 71
  3136. '
  3137.      SUB DefaultU STATIC
  3138.      ZWasA =    -ZPromptBell          -2 * ZExpertUser _
  3139.             -4 * ZNulls               -8 * ZUpperCase _
  3140.            -16 * ZLineFeeds          -32 * ZCheckBulletLogon _
  3141.            -64 * ZSkipFilesLogon    -128 * ZAutoDownDesired _
  3142.           -256 * ZReqQuesAnswered   -512 * ZMailWaiting _
  3143.          -1024 * (NOT ZHiLiteOff)  -2048 * ZTurboKeyUser
  3144.      WasX = 3*ZUserTextColor - 63 + 21*VAL(ZBoldText$) + ZWasGR
  3145.      IF WasX < 1 OR WasX > 255 THEN _
  3146.         WasX = 48
  3147.      LSET ZUserOption$ = _
  3148.         MKI$(ZTimesLoggedOn) + _
  3149.         MKI$(ZLastMsgRead) + _
  3150.         ZUserXferDefault$ + _
  3151.         CHR$(WasX) + _
  3152.         MKI$(ZRightMargin) + _
  3153.         MKI$(ZWasA) + _
  3154.         ZRegDate$ + _
  3155.         CHR$(ZPageLength) + _
  3156.         ZEchoer$
  3157.      END SUB
  3158. 9801 ' $SUBTITLE: 'WhosOn - subroutine to display who is on'
  3159. ' $PAGE
  3160. '
  3161. '  NAME    -- WhosOn
  3162. '
  3163. '  INPUTS  --     PARAMETER                    MEANING
  3164. '                NumNodes                   # of nodes to check
  3165. '                ZActiveMessageFile$        Current message file
  3166. '                ZOrigMsgFile$              Main msg file
  3167. '
  3168. '  OUTPUTS --  None
  3169. '
  3170. '  PURPOSE --  To display who is on each node.
  3171. '
  3172.      SUB WhosOn (NumNodes) STATIC
  3173.      WasA1$ = ZActiveMessageFile$
  3174.      ZActiveMessageFile$ = ZOrigMsgFile$
  3175.      CALL OpenMsg
  3176.      FIELD 1, 128 AS ZMsgRec$
  3177.      FOR NodeIndex = 2 TO NumNodes + 1
  3178.         GET 1,NodeIndex
  3179.         ZOutTxt$ = ZFG1$ + "Node" + _
  3180.              STR$(NodeIndex - 1) + ZFG2$
  3181.         RecIndex = VAL(MID$(ZMsgRec$,44,2))
  3182.         IF RecIndex = 0 THEN _
  3183.            RecIndex = -1
  3184.         WasAX$ = MID$(ZBaudRates$,(-5 * RecIndex ),5) + _
  3185.               " BAUD: "
  3186.         IF MID$(ZMsgRec$,55,2) = "-1" AND NOT ZSysop THEN _
  3187.            ZWasY$ = "SYSOP" + SPACE$(21) _
  3188.         ELSE ZWasY$ = MID$(ZMsgRec$,1,26)
  3189.         WasAX$ = WasAX$ + ZFG3$ + ZWasY$
  3190.         IF MID$(ZMsgRec$,40,2) <> "-1" THEN                          'CHT021401
  3191.            WasAX$ = WasAX$ + ZFG4$ + MID$(ZMsgRec$,93,22)            'CHT021401
  3192.         ELSE                                                         'CHT021401
  3193.            WasAX$ = WasAX$ + ZFG4$ + "(has opened a door)"           'CHT021401
  3194.         END IF                                                       'CHT021401
  3195.         IF MID$(ZMsgRec$,57,1) = "A" THEN _
  3196.            ZOutTxt$ = ZOutTxt$ + "  Online at " + _
  3197.                 WasAX$ _
  3198.         ELSE IF NOT ZSysop THEN _
  3199.                 ZOutTxt$ = ZOutTxt$ + _
  3200.                      " Waiting for next caller" _
  3201.              ELSE ZOutTxt$ = ZOutTxt$ + _
  3202.                        " Offline at " + _
  3203.                        WasAX$
  3204.         CALL QuickTPut1 (ZOutTxt$)
  3205.         CALL AskMore ("",ZTrue,ZTrue,ZAnsIndex,ZFalse)
  3206.         IF ZNo THEN _
  3207.            NodeIndex = NumNodes + 2
  3208.      NEXT
  3209.      ZActiveMessageFile$ = WasA1$
  3210.      CALL QuickTPut (ZEmphasizeOff$,0)
  3211.      END SUB
  3212. 10410 ' $SUBTITLE: 'RecoverMsg - sub to recover deleted messages'
  3213. ' $PAGE
  3214. '
  3215. '  NAME    -- RecoverMsg
  3216. '
  3217. '  INPUTS  --     PARAMETER                    MEANING
  3218. '               MsgToRecover          MESSAGE NUMBER TO RECOVER
  3219. '               FirstMsgRecord        RECORD # FOR First MSG
  3220. '
  3221. '  OUTPUTS --  ActionFlag                 SET TO 0 IF ERROR
  3222. '                                         SET TO -1 IF No ERROR
  3223. '
  3224. '  PURPOSE --  To recover deleted messages.  Note that this is only
  3225. '              possible if you have not compressed your message file
  3226. '              using config.
  3227. '
  3228.       SUB RecoverMsg (MsgToRecover,FirstMsgRecord,ActionFlag) STATIC
  3229. '      FIELD #1,128 AS ZMsgRec$
  3230. '      MsgRec = FirstMsgRecord
  3231. '10420 GET 1,MsgRec
  3232. '      NumRecsInMsg = VAL(MID$(ZMsgRec$,117,4))
  3233. '      IF NumRecsInMsg < 1 OR MsgRec => ZNextMsgRec THEN _
  3234. '         ZWasY$ = "No Msg #" + _
  3235. '              STR$(MsgToRecover) : _
  3236. '         GOTO 10485
  3237. '10440 IF VAL(MID$(ZMsgRec$,2,4)) <> MsgToRecover THEN _
  3238. '         MsgRec = MsgRec + NumRecsInMsg : _
  3239. '         GOTO 10420
  3240. '10450 IF INSTR(ZMsgRec$,ZDeletedMsg$) <> 0 THEN _
  3241. '         LSET ZMsgRec$ = LEFT$(ZMsgRec$,115) + _
  3242. '                                ZActiveMessage$ + _
  3243. '                                MID$(ZMsgRec$,117) : _
  3244. '         PUT 1,LOC(1) : _
  3245. '         ZWasY$ = "Restored Msg #" + _
  3246. '              STR$(MsgToRecover) : _
  3247. '         ActionFlag = ZTrue : _
  3248. '         GOTO 10485
  3249. '10480 ZWasY$ = "Msg #" + _
  3250. '           STR$(MsgToRecover) + _
  3251. '           " not Dead"
  3252. '10485 CALL QuickTPut1 (ZWasY$)
  3253.       END SUB
  3254. 10600 ' $SUBTITLE: 'UpdateU -- Update the users record at logoff'
  3255. ' $PAGE
  3256. '  NAME    -- UpdateU
  3257. '
  3258. '  INPUTS  -- PARAMETER             MEANING
  3259. '             ZAdjustedSecurity
  3260. '             ZCurDate$
  3261. '             ZDnlds
  3262. '             ZElapsedTime
  3263. '             ZListDir
  3264. '             ZMainUserFileIndex
  3265. '             ZSecsPerSession!
  3266. '             ZUplds
  3267. '             ZUserSecLevel
  3268. '
  3269. '  OUTPUTS -- ZElapsedTime$
  3270. '             ZListNewDate$
  3271. '             ZSecLevel$
  3272. '             ZUserDnlds$
  3273. '             ZUserUplds$
  3274. '
  3275. '  PURPOSE -- Update the user record for the user when the user
  3276. '             exits RBBS-PC.
  3277. '
  3278.       SUB UpdateU (LoggingOff) STATIC
  3279.       IF ZActiveUserName$ = "" OR ZFirstName$ = "" THEN _
  3280.          EXIT SUB
  3281.       IF ZActiveUserFile$ = ZOrigUserFile$ THEN _
  3282.          ZUplds = ZGlobalUplds : _
  3283.          ZDnlds = ZGlobalDnlds : _
  3284.          ZDLToday! = ZGlobalDLToday! : _
  3285.          ZBytesToday! = ZGlobalBytesToday! : _
  3286.          ZDLBytes! = ZGlobalDLBytes! : _
  3287.          ZULBytes! = ZGlobalULBytes! : _
  3288.          ZBankTime = ZGlobalBankTime               'Pe 03/21/90
  3289.       IF ZUserFileIndex < 1 THEN _
  3290.          GOTO 10607
  3291.       UpdateDefaults = ZTrue
  3292. 10602 ZSubParm = 6
  3293.       CALL FileLock
  3294.       CALL OpenUser (HighestUserRecord)
  3295.       FIELD 5,31 AS ZUserName$, _
  3296.               15 AS ZPswd$, _
  3297.                2 AS ZSecLevel$, _
  3298.               14 AS ZUserOption$,  _
  3299.               24 AS ZCityState$, _
  3300.               2 AS MachineType$, _
  3301.               1 AS ZBankTime$,_                        'SRK030690
  3302.               4 AS ZTodayDl$, _
  3303.               4 AS ZTodayBytes$, _
  3304.               4 AS ZDlBytes$, _
  3305.               4 AS ZULBytes$, _
  3306.               14 AS ZLastDateTimeOn$, _
  3307.                3 AS ZListNewDate$, _
  3308.                2 AS ZUserDnlds$, _
  3309.                2 AS ZUserUplds$, _
  3310.                2 AS ZElapsedTime$
  3311. 10604 GET 5,ZUserFileIndex
  3312.       IF UpdateDefaults THEN _
  3313.          CALL DefaultU
  3314.       IF ZListDir THEN _
  3315.          LSET ZListNewDate$ = CHR$(VAL(MID$(ZCurDate$,7,2))) + _
  3316.                                CHR$(VAL(MID$(ZCurDate$,1,2))) + _
  3317.                                CHR$(VAL(MID$(ZCurDate$,4,2)))
  3318. 10605 LSET ZUserDnlds$ = MKI$(ZDnlds)
  3319.       LSET ZUserUplds$ = MKI$(ZUplds)
  3320.       LSET ZTodayDl$ = MKS$(ZDLToday!)
  3321.       LSET ZTodayBytes$ = MKS$(ZBytesToday!)
  3322.       LSET ZDlBytes$ = MKS$(ZDLBytes!)
  3323.       LSET ZULBytes$ = MKS$(ZULBytes!)
  3324.       CALL CheckTime (ZUserLogonTime!, ZSecsUsedSession!, 2)
  3325.       IF (NOT ZExitToDoors) AND LoggingOff THEN _
  3326.          TempElapsed! = ZElapsedTime + _
  3327.                        (ZSecsUsedSession! - ZTimeCredits!) / 60 : _
  3328.          ZTimeCredits! = 0 _
  3329.       ELSE TempElapsed! = ZElapsedTime
  3330.       IF TempElapsed! < -32767 THEN _
  3331.          TempElapsed! = -32767 _
  3332.       ELSE IF TempElapsed! > 32767 THEN _
  3333.          TempElapsed! = 32767
  3334.       LSET ZElapsedTime$ = MKI$(TempElapsed!)
  3335.       IF ZAdjustedSecurity THEN _
  3336.          LSET ZSecLevel$ = MKI$(ZUserSecLevel)
  3337.       IF ZBankTime > 125 then ZBankTime = 125         'Pe 03/20/90
  3338.       if ZBankTime <= 0 then ZBankTime = 0            'SRK030690 
  3339.       LSET ZBankTime$ = CHR$(ZBankTime)               'SRK030690 
  3340.       PUT 5,ZUserFileIndex
  3341.       ZSubParm = 8
  3342.       CALL FileLock
  3343.       IF ZActiveUserFile$ <> ZOrigUserFile$ AND LoggingOff THEN _
  3344.          ZActiveUserFile$ = ZOrigUserFile$ : _
  3345.          ZUserFileIndex = ZOrigUserFileIndex : _
  3346.          UpdateDefaults = ZFalse : _
  3347.          GOTO 10602
  3348. 10607 IF ZExitToDoors OR NOT LoggingOff THEN _
  3349.          EXIT SUB
  3350. '      Temp = ZMinsPerSession
  3351. '      IF ZMaxPerDay > 0 THEN _
  3352. '         Temp = ZMaxPerDay - TempElapsed! : _
  3353. '         IF Temp > ZMinsPerSession THEN _
  3354. '            Temp = ZMinsPerSession
  3355. '      Temp = -(Temp > 0) * Temp
  3356. CALL QuickTPut1 (ZFG1$ + STR$(MinsRemaining)+ ZFG2$ +" min left Today") ' Pe 03/20/90
  3357. CALL QuickTPut1 (ZFG3$+" Banked Time:  " + ZFG1$+  STR$(ZGlobalBankTime) + ZFG4$+" minutes.")
  3358. CALL QuickTPut1 ("God bless you, " + ZFG3$ + ZFirstName$ + ZFG4$ + ", and thank you for calling "+_  ' Bh
  3359.                  ZFG1$ + ZRBBSName$ +ZFG2$ +".")        ' Bh
  3360.       CALL QuickTPut1 (ZColorReset$) 'Pe 02/05/90
  3361.       CALL DelayTime (8 + ZBPS)
  3362.       END SUB
  3363. 10935 ' $SUBTITLE: 'DosExit -- Setup to exit to DOS for ZSysop'
  3364. ' $PAGE
  3365. '  NAME    -- DosExit
  3366. '
  3367. '  INPUTS  -- PARAMETER             MEANING
  3368. '             ZComPort$
  3369. '             ZDoorsTermType
  3370. '             ZMultiLinkPresent
  3371. '             ZRBBSBat$
  3372. '             ZRedirectIOMethod
  3373. '             ZUseDeviceDriver$
  3374. '
  3375. '  OUTPUTS -- ZWasQ                    NUMBER OF LINES TO WRITE OUT TO
  3376. '                                      ZRCTTYBat$
  3377. '             ZUserIn$()               LINES TO WRITE OUT TO ZRCTTYBat$
  3378. '
  3379. '  PURPOSE -- Set up ZUserIn$() and ZWasQ in order to call "RBBSExit" and
  3380. '             exit to DOS for the remote RBBS-PC sysop
  3381. '
  3382.       SUB DosExit STATIC
  3383.       IF ZMultiLinkPresent AND _
  3384.          ZDoorsTermType > 0 THEN _
  3385.          ZFF = 0 : _
  3386.          GOTO 10950
  3387.       ZOutTxt$(1) = "ECHO OFF"
  3388.       IF ZUseDeviceDriver$ <> "" THEN _
  3389.          Port$ = ZUseDeviceDriver$ _
  3390.       ELSE Port$ = "GATE" + RIGHT$(ZComPort$,1)
  3391.       IF ZRedirectIOMethod THEN _
  3392.          ZFF = 5 : _
  3393.          ZOutTxt$(2) = "CTTY " + _
  3394.                  Port$ : _
  3395.          ZOutTxt$(3) = ZDiskForDos$ + _
  3396.                  "COMMAND" : _
  3397.          ZOutTxt$(4) = "CTTY CON" : _
  3398.          ZOutTxt$(5) = ZRBBSBat$ _
  3399.       ELSE ZFF = 3 : _
  3400.            ZOutTxt$(2) = ZDiskForDos$ + _
  3401.                    "COMMAND >" + _
  3402.                    Port$ + _
  3403.                    " <" + _
  3404.                    Port$ : _
  3405.            ZOutTxt$(3) = ZRBBSBat$
  3406. 10950 CALL AMorPM
  3407.       CALL UpdtCalr ("Exited to DOS at " + ZTime$,2)
  3408.       CALL QuickTPut1 ("RBBS-PC " + ZVersionID$)
  3409.       CALL QuickTPut1 ("SYSOP in Remote Console Mode")
  3410.       CALL RBBSExit (ZOutTxt$(),ZFF)
  3411.       END SUB
  3412. 10976 ' $SUBTITLE: 'WordInFile -- Searches a file to find a word'
  3413. ' $PAGE
  3414. '  NAME    -- WordInFile
  3415. '
  3416. '  INPUTS  -- PARAMETER             MEANING
  3417. '             FilName$              FILE TO SEARCH IN
  3418. '             Strng$                STRING TO SEARCH FOR
  3419. '
  3420. '  OUTPUTS -- InFile                WHETHER STRING Found IN FILE
  3421. '
  3422. '  PURPOSE -- Searches for "Strng$" in file "FILNAME$."  Used to
  3423. '             limit doors and questionnaires to those specified
  3424. '             in their menu files.  The "Strng$" is capitalized
  3425. '             but not the lines in the file, so must be exact
  3426. '             case-sensitive match to be found.  The only character
  3427. '             that can immediately proceed or end a name to be
  3428. '             found must be a blank.
  3429. '
  3430.       SUB WordInFile (FilName$,Strng$,InFile) STATIC
  3431.       InFile = ZFalse
  3432.       CALL FindIt (FilName$)
  3433.       IF NOT ZOK THEN _
  3434.          EXIT SUB
  3435.       WasX = 0
  3436.       CALL AllCaps (Strng$)
  3437.       WHILE NOT EOF(2) AND WasX < 1
  3438.          LINE INPUT #2,ZOutTxt$
  3439.          WasY = 1
  3440. 10978    WasX = INSTR(WasY,ZOutTxt$,Strng$)
  3441.          IF WasX < 1 THEN _
  3442.             GOTO 10980
  3443.          WasY = WasX + 1
  3444.          IF WasX > 1 THEN _
  3445.             IF MID$(ZOutTxt$,WasX - 1,1) <> " " THEN _
  3446.                WasX = 0
  3447.          IF WasX > 0 THEN _
  3448.             WasL = LEN(Strng$) : _
  3449.             IF LEN(ZOutTxt$) => (WasX + WasL) THEN _
  3450.                IF MID$(ZOutTxt$,WasX + WasL,1) <> " " THEN _
  3451.                   WasX = 0
  3452.          IF WasX = 0 THEN _
  3453.             GOTO 10978
  3454. 10980 WEND
  3455.       CLOSE 2
  3456.       InFile = (WasX > 0)
  3457.       END SUB
  3458. 10983 ' $SUBTITLE: 'DoorExit -- Setup to exit to a "door"'
  3459. ' $PAGE
  3460. '  NAME    -- DoorExit
  3461. '
  3462. '  INPUTS  -- PARAMETER             MEANING
  3463. '             ZMultiLinkPresent
  3464. '             ZNodeID$
  3465. '             ZRBBSBat$
  3466. '             ZWasZ$
  3467. '
  3468. '  OUTPUTS -- ZWasQ                    NUMBER OF LINES TO WRITE OUT TO
  3469. '                                      ZRCTTYBat$
  3470. '             ZUserIn$()               LINES TO WRITE OUT TO ZRCTTYBat$
  3471. '
  3472. '  PURPOSE -- Set up ZUserIn$() and ZWasQ in order to call "EXITRBBS" and
  3473. '             exit RBBS-PC to invoke another program
  3474. '
  3475.       SUB DoorExit STATIC
  3476.       IF ZWasZ$ = "" OR _
  3477.          ZWasZ$ = "NONE" THEN _
  3478.          EXIT SUB
  3479.       CALL FindIt (ZWasZ$)
  3480.       IF NOT ZOK THEN _
  3481.          GOTO 10986
  3482.       CALL BreakFileName (ZWasZ$,WasX$,ExitTo$,ExitMethod$,ZFalse)   ' KG032501
  3483.       ExitMethod$ = ""
  3484.       ZDooredTo$ = ExitTo$
  3485.       CALL FindIt (ZDoorsDef$)
  3486.       IF NOT ZOK THEN _
  3487.          ExitTo$ = ExitTo$ + " " + ZNodeID$ : _
  3488.          GOTO 10989
  3489. 10985 CALL ReadParms (ZOutTxt$(),9,1)                     'DGS-DORSEC
  3490.       IF ZErrCode > 0 THEN _
  3491.          ExitTo$ = ExitTo$ + " " + ZNodeID$ : _
  3492.          GOTO 10989
  3493.       IF ExitTo$ <> ZOutTxt$(1) THEN _
  3494.          GOTO 10985
  3495.       CALL CheckInt (ZOutTxt$(2))
  3496.       IF ZErrCode > 0 THEN _
  3497.          ZErrCode = 0 : _
  3498.          GOTO 10985
  3499.       IF ZUserSecLevel < ZTestedIntValue THEN _
  3500.          CALL QuickTPut1 ("Insufficient security for door") : _
  3501.          EXIT SUB
  3502.       CALL CheckInt (ZOutTxt$(9))                                 'DGS-DORSEC
  3503.       IF ZErrCode > 0 THEN _                                      'DGS-DORSEC
  3504.          ZErrCode = 0 : _                                         'DGS-DORSEC
  3505.          GOTO 10985                                               'DGS-DORSEC
  3506. '      IF ZUserSecLevel > ZTestedIntValue THEN _                   'DGS-DORSEC   ' Bh 100890
  3507. '         CALL QuickTPut1 ("Invalid Security for Door" + ExitTo$) : _ 'DGS-DORSEC
  3508. '         EXIT SUB                                                 'DGS-DORSEC
  3509.       WasX$ = LEFT$(ZOutTxt$(5),INSTR(ZOutTxt$(5)+" "," ")-1)
  3510.       CALL FindIt (WasX$)
  3511.       IF NOT ZOK THEN _
  3512.          GOTO 10986
  3513.       ZFileName$ = ZOutTxt$(3)
  3514.       ExitMethod$ = ZOutTxt$(4)
  3515.       ExitTemplate$ = ZOutTxt$(5)
  3516.       ZDoorDisplay$ = ZOutTxt$(7)
  3517.       DoorTime$ = ZOutTxt$(8)
  3518.       CALL AskUsers
  3519.       CALL SmartText (ExitTemplate$,ZFalse,ZFalse)
  3520.       CALL MetaGSR (ExitTemplate$,ZFalse)
  3521.       ExitTo$ = ExitTemplate$
  3522.       GOTO 10989
  3523. 10986 ZOutTxt$ = "Missing door program"
  3524.       CALL UpdtCalr (ZOutTxt$ + " " + ZWasZ$,1)
  3525.       ZSnoop = ZTrue
  3526.       CALL LPrnt (ZOutTxt$,1)
  3527.       EXIT SUB
  3528. 10989 IF ZTransferFunction = 3 THEN _
  3529.          ZWasY$ = "Registration" _
  3530.       ELSE ZWasY$ = "Invoking Special " + ZDooredTo$ + " Feature of " + ZRBBSName$  ' Bh 102690
  3531.       ZOutTxt$ = ZWasY$ + _
  3532.            " at " + _
  3533.            TIME$ + _
  3534.            " on " + _
  3535.            DATE$
  3536.       ZSubParm = 5
  3537.       CALL TPut
  3538.       CALL UpdtCalr (ZDooredTo$ + " door opened at" + " " + Time$,2)'DGS-010Mod     ' Bh 090890
  3539.       CALL QuickTPut (ZFG4$+"Please stay on line...this takes a few seconds....",2)  ' Bh
  3540.       CLOSE 2
  3541.       OPEN "O",2,"DORINFO" + _
  3542.                  ZNodeFileID$ + _
  3543.                  ".DEF"
  3544.       PRINT #2,ZRBBSName$
  3545.       PRINT #2,ZSysopFirstName$
  3546.       PRINT #2,ZSysopLastName$
  3547.       IF ZLocalUser THEN _
  3548.          PRINT #2,"COM0" _
  3549.       ELSE PRINT #2,ZComPort$
  3550.       ZUserIn$ = MID$(ZBaudParity$,INSTR(ZBaudParity$," B"))
  3551.       PRINT #2,ZTalkToModemAt$;ZUserIn$
  3552.       PRINT #2,ZNetworkType
  3553.       IF ZGlobalSysop THEN _
  3554.          PRINT #2,"SYSOP" : _
  3555.          PRINT #2,"" _
  3556.       ELSE PRINT #2,ZFirstName$ : _
  3557.            PRINT #2,ZLastName$
  3558.       PRINT #2,ZCityState$
  3559.       PRINT #2,ZWasGR
  3560.       PRINT #2,ZUserSecLevel
  3561.       CALL TimeRemain (MinsRemaining)
  3562.       CALL CheckInt (DoorTime$)
  3563.       IF ZErrCode = 0 AND ZTestedIntValue > 0 THEN _
  3564.          IF MinsRemaining > ZTestedIntValue THEN _
  3565.             MinsRemaining = ZTestedIntValue
  3566.       PRINT #2,INT(MinsRemaining)
  3567.       PRINT #2,ZFossil
  3568.       PRINT #2,ZBaudParity$                           'ELS083090
  3569. '      PRINT #2,ZBankTime                             'SRK030690
  3570.       IF ExitMethod$ = "S" THEN _
  3571.          CALL ShellExit (ExitTemplate$) : _
  3572.          ZExitToDoors = ZTrue : _
  3573.          CALL BufFile (ZDoorDisplay$,WasX) : _
  3574.          CALL DoorReturn _
  3575.       ELSE ZOutTxt$(1) = ZDiskForDos$ + _
  3576.                   "COMMAND /C " + _
  3577.                   ExitTo$ : _
  3578.            ZOutTxt$(2) = ZRBBSBat$ : _
  3579.            CALL RBBSExit (ZOutTxt$(),2)
  3580.       END SUB
  3581. 10992 ' $SUBTITLE: 'RBBSExit -- Setup to exit RBBS'
  3582. ' $PAGE
  3583. '  NAME    -- RBBSExit
  3584. '
  3585. '  INPUTS  -- PARAMETER             MEANING
  3586. '             LINE.ARA        Array of lines to write to batch file
  3587. '             NumLines        How many lines in array
  3588. '
  3589. '  OUTPUTS -- ZRCTTYBat$
  3590. '
  3591. '  PURPOSE -- To create a batch file that control can be passed to
  3592. '             and to exit RBBS-PC while still keeping carrier up
  3593. '
  3594.       SUB RBBSExit (LineAra$(1),NumLines) STATIC
  3595.       CLOSE 2
  3596.       IF NumLines = 0 THEN _
  3597.          GOTO 10994
  3598.       OPEN "O",2,ZRCTTYBat$
  3599.       FOR WasI = 1 TO NumLines
  3600.          IF LineAra$(WasI) <> "" THEN _
  3601.             PRINT #2,LineAra$(WasI)
  3602.       NEXT
  3603.       CLOSE 2
  3604. 10994 CLOSE 3
  3605.       ZExitToDoors = ZTrue
  3606.       IF NOT ZFossil THEN _
  3607.          OUT ZModemCntlReg,INP(ZModemCntlReg) OR 1
  3608.       IF NOT ZPrivateDoor THEN _
  3609.          CALL MLInit (2)
  3610. 10996 CALL UpdateU (ZTrue)
  3611.       CALL GetTime
  3612.       CALL SaveProf (1)
  3613.       IF NumLines = 0 THEN _
  3614.          EXIT SUB
  3615.       CALL DelayTime (9 + ZBPS)
  3616.       SYSTEM
  3617.       END SUB
  3618. 12000 ' $SUBTITLE: 'SetSection -- Setup section prompts'
  3619. ' $PAGE
  3620. '  NAME    -- SetSection         Doug Azzarito
  3621. '
  3622. '  INPUTS  -- PARAMETER             MEANING
  3623. '             ZMenuIndex      2 = user is in MAIN section
  3624. '                             3 = user is in FILE section
  3625. '                             4 = user is in UTIL section
  3626. '                             6 = user is in LIBR section
  3627. '
  3628. '  OUTPUTS -- ZSection$       4 character section name
  3629. '             ZActiveMenu$    1 character section name
  3630. '             ZSectionPrompt$ Section name (if ZShowSection config)
  3631. '             ZCmdPrompt$     Command input prompt string
  3632. '             ZSectionOpts$   List of options valid in this sect
  3633. '             ZInvalidOpts$   List of options invalid in this sect
  3634. '             ZSubSection     Index into security array for section
  3635. '
  3636. '  PURPOSE -- To build the prompt strings for the current section
  3637. '
  3638.       SUB SetSection STATIC
  3639.       IF ZMenuIndex <> 6 THEN _
  3640.          ZCurDirPath$ = ZDirPath$
  3641.       ON ZMenuIndex GOTO 12001, 12010,12005,12020,12001,12015
  3642. 12001 EXIT SUB
  3643. 12005 LSET ZSection$ = "FILE"
  3644.       ZSectionOpts$ = ZFileOpts$
  3645.       ZInvalidOpts$ = ZInvalidFileOpts$
  3646.       ZSubSection = ZBegFile
  3647.       GOTO 12025
  3648. 12010 LSET ZSection$ = "MAIN"
  3649.       ZSectionOpts$ = ZMainOpts$
  3650.       ZInvalidOpts$ = ZInvalidMainOpts$
  3651.       ZSubSection = ZBegMain
  3652.       GOTO 12025
  3653. 12015 LSET ZSection$ = "LIBR"
  3654.       ZSectionOpts$ = ZLibOpts$
  3655.       ZInvalidOpts$ = ZInvalidLibraryOpts$
  3656.       ZSubSection = ZBegLibrary
  3657.       ZCurDirPath$ = ZLibDirPath$
  3658.       GOTO 12025
  3659. 12020 LSET ZSection$ = "UTIL"
  3660.       ZSectionOpts$ = ZUtilOpts$
  3661.       ZInvalidOpts$ = ZInvalidUtilOpts$
  3662.       ZSubSection = ZBegUtil
  3663. 12025 ZActiveMenu$ = LEFT$(ZSection$,1)
  3664.       LSET ZLastCommand$ = ZActiveMenu$ + " "
  3665.       IF ZShowSection THEN _
  3666.          ZSectionPrompt$ = ZSection$ _
  3667.       ELSE ZSectionPrompt$ = "Your"
  3668.       IF ZCmndsInPrompt=0 THEN _
  3669.           ZSectionOpts$ = ""
  3670.       ZCmdPrompt$ = ZSectionPrompt$ + _
  3671.                         " command" + _
  3672.                         ZSectionOpts$
  3673.       END SUB
  3674. 12878 ' $SUBTITLE: 'UntilRight - asks question until answer okay'
  3675. ' $PAGE
  3676. '
  3677. '  NAME    -- UntilRight
  3678. '
  3679. '  INPUTS  -- PARAMETER             MEANING
  3680. '             Ques$         QUESTION TO BE ASKED THE USER
  3681. '             Ans$          LOCATION TO STORE THE ANSWER
  3682. '             MinLen        MINIMUM LENGTH OF ANSWER
  3683. '             MaxLen        MAX LENGTH OF ANSWER
  3684. '
  3685. '  OUTPUTS -- Ans$          RESPONSE TO THE QUESTION WHICH THE
  3686. '                                      CALLERS SAYS IS CORRECT
  3687. '
  3688. '  PURPOSE -- Subroutine to ask a user a question until the caller
  3689. '             responds that the answer is correct
  3690. '
  3691.       SUB UntilRight (Ques$,Ans$,MinLen,MaxLen) STATIC
  3692. 12880 ZSubParm = 1
  3693.       ZOutTxt$ = Ques$
  3694.       CALL TGet
  3695.       IF ZSubParm = -1 THEN _
  3696.          GOTO 12882
  3697.       IF ZWasQ = 0 THEN _
  3698.          GOTO 12880
  3699.       IF LEN(ZUserIn$(1)) > MaxLen THEN _
  3700.          CALL QuickTPut1 (STR$(MaxLen) + " chars max") : _
  3701.          GOTO 12880_
  3702.       ELSE IF LEN(ZUserIn$(1)) < MinLen THEN _
  3703.               CALL QuickTPut1 (STR$(MinLen) + " chars min") : _
  3704.               GOTO 12880
  3705.       Ans$ = ZUserIn$(1)
  3706.       ZOutTxt$ = ZUserIn$(1) + _
  3707.            ", right ([Y],N)"
  3708.       ZTurboKey = -ZTurboKeyUser
  3709.       ZSubParm = 1
  3710.       CALL TGet
  3711.       IF ZSubParm = -1 THEN _
  3712.          GOTO 12882
  3713.       IF ZNo THEN _
  3714.          GOTO 12880
  3715.       CALL AllCaps (Ans$)
  3716.       EXIT SUB
  3717. 12882 Ans$ = "GUEST"
  3718.       END SUB
  3719. 13660 ' $SUBTITLE: 'LogError - sub to log errors to CALLERS file'
  3720. ' $PAGE
  3721. '
  3722. '  NAME    -- LogError
  3723. '
  3724. '  INPUTS  --     PARAMETER                    MEANING
  3725. '                    ERR           ERROR NUMBER DETECTED BY BASIC
  3726. '                    ERL           Last LINE NUMBER ENCOUNTERED
  3727. '                                  PRIOR TO ENCOUNTERNING ERROR
  3728. '
  3729. '  OUTPUTS -- NONE
  3730. '
  3731. '  PURPOSE -- To set up a string to write to the callers log
  3732. '             indicating the date, time, error, and error line
  3733. '
  3734.       SUB LogError STATIC
  3735.       WasIX = ERR
  3736.       IF ERR < 1 THEN _
  3737.          WasIX = ZErrCode
  3738.       CALL UpdtCalr("+++ Error " + _
  3739.            STR$(WasIX) + _
  3740.            " line " + _
  3741.            STR$(ERL) + _
  3742.            " at " + _
  3743.            TIME$ + _
  3744.            " on " + _
  3745.            DATE$,2)
  3746.       END SUB
  3747. '
  3748. 20096 ' $SUBTITLE: 'CheckRatio - subroutine to print ul/dl ratio'
  3749. ' $PAGE
  3750. '
  3751. '  NAME    -- CheckRatio
  3752. '
  3753. '  INPUTS  --   PARAMETER                    MEANING
  3754. '               TellUser           TELL USER THEIR RATIO
  3755. '               ZDnlds             FILES DOWNLOADED
  3756. '               ZDLBytes!          BYTES DOWNLOADED
  3757. '               ZUplds             FILES UPLOADED
  3758. '               ZULBytes!          BYTES UPLOADED
  3759. '
  3760. '  OUTPUTS --   ZOK                 -1 if okay to download, 0 otherwise
  3761. '
  3762. '  PURPOSE -- To determine whether the users violated
  3763. '             their upload to download restriction
  3764. '
  3765.       SUB CheckRatio (TellUser) STATIC
  3766.       ZOK = ZTrue
  3767. '      IF NOT ZEnforceRatios THEN _
  3768. '         GOTO 20110
  3769. '      IF ZRatioRestrict# <= 0 THEN _
  3770. '         GOTO 20110
  3771. '
  3772. ' Detemine method of ratio checking.  Look ahead to amount downloaded
  3773. '
  3774.       IF ZByteMethod = 1 OR ZByteMethod = 3 THEN _
  3775.          Method$ = "Bytes" : _
  3776.          ULWork# = ZULBytes! : _
  3777.          DLWork# = ZDLBytes! + ZNumDnldBytes!
  3778.       IF ZByteMethod = 0 OR ZByteMethod = 2 THEN _
  3779.          Method$ = "Files" : _
  3780.          ULWork# = ZUplds : _
  3781.          DLWork# = ZDnlds + ZDownFiles
  3782.       IF ULWork# < ZInitialCredit# THEN _
  3783.          ULWork# = ZInitialCredit#
  3784.       IF ZByteMethod = 2 THEN _
  3785.          Today# = ZRatioRestrict# - ZDLToday! - ZDownFiles
  3786.       IF ZByteMethod = 3 THEN _
  3787.          Today# = ZRatioRestrict# - ZBytesToday! - ZNumDnldBytes!
  3788. '
  3789.       Ratio# = 0
  3790.       RatioSuffix$ = ":0"
  3791.       IF ULWork# > 0 THEN _
  3792.          Ratio# = (DLWork# / ULWork#) : _
  3793.          RatioSuffix$ = ":1"
  3794.       IF ZByteMethod > 1 THEN _
  3795.  ZOutTxt$ =  "Todays Downloaded Files: " + STR$(ZDLToday! + ZDownFiles)+ZCrLf$ + _
  3796.              "Number of Bytes today  : " + STR$(ZBytesToday! + ZNumDnldBytes!) : _
  3797.          ZSubParm = 5 : _
  3798.          CALL TPut : _
  3799.   Call Skipline (1) : _
  3800.   Goto 20100
  3801.       WasX$ = STR$(Ratio#)
  3802.       X = INSTR(WasX$,".")
  3803.       IF X > 0 THEN _
  3804.          WasX$ = LEFT$(WasX$,X+1)
  3805. ZOutTxt$ = ZFG1$ + Method$ + " Downloaded: " + ZFG2$ +STR$(DLWork#)+ZCrLf$+ _
  3806.            ZFG3$ + Method$ + " Uploaded  : " + ZFG2$ +STR$(ULWork#) + ZCrLf$
  3807. ZOutTxt$ = ZoutTxt$ +  ZFG4$ + "Todays Downloaded Files: " + ZFG1$ + _
  3808.           STR$(ZDLToday! + ZDownFiles) + ZCrLf$ +"Ratio  : " +ZFG3$ + _
  3809.                              WasX$ + RatioSuffix$ +ZEmphasizeOff$
  3810.          ZSubParm = 5
  3811.          CALL TPut        'Pe 02/16/90
  3812. '
  3813. '  CHECK TO SEE IF THE USER HAS VIOLATED THEIR UL/DL RESTRICTION
  3814. '
  3815. 20100   IF NOT ZEnforceRatios OR ZRatioRestrict# <= 0 THEN _
  3816.          GOTO 20110                                               'Pe 02/16/90
  3817.       IF NOT (ZRatioRestrict# > 0 AND TellUser) THEN _            'Pe 02/16/90
  3818.          EXIT SUB
  3819.       IF ZByteMethod <= 1 THEN _
  3820.          GOTO 20105
  3821.       IF Today# < 0 THEN _
  3822.          ZOutTxt$ = "Sorry, Daily download limit of" + _
  3823.               STR$(ZRatioRestrict#) + " " + _
  3824.               Method$ + " Reached" : _
  3825.          ZOK = ZFalse _
  3826.       ELSE ZOutTxt$ = "Download balance remaining:" + _
  3827.                 STR$(Today#) + _
  3828.                 " " + _
  3829.                 Method$ : _
  3830.            ZOK = ZTrue
  3831.       ZSubParm = 5
  3832.       CALL TPut
  3833.       CALL SkipLine(1)
  3834.       CALL DelayTime (3)   'Pe 02/03/90
  3835.       EXIT SUB
  3836. '
  3837. 20105 IF Ratio# >= ZRatioRestrict# OR ULWork# = 0 THEN _
  3838.          ZOK = ZFalse : _
  3839.          ZOutTxt$ = "Sorry, DL/UL ratio of" + _
  3840.               STR$(ZRatioRestrict#) + _
  3841.               ":1 " + _
  3842.               Method$ + " exceeded" : _
  3843.          ZSubParm = 5 : _
  3844.          CALL TPut : _
  3845.          ZOutTxt$ = "Minimum upload of" + _
  3846.               STR$(INT(((DLWork# - (ULWork# * ZRatioRestrict#)) _
  3847.               / ZRatioRestrict#) + 1)) + _
  3848.               + " " + Method$ + " required to download" _
  3849.       ELSE ZOutTxt$ = "Balance remaining before upload required:" + _
  3850.                 STR$(INT((ULWork# * ZRatioRestrict#)-DLWork#)) + _
  3851.                 " " + Method$
  3852.       ZSubParm = 5
  3853.       CALL TPut
  3854.       CALL SkipLine (1)
  3855.       CALL DelayTime (2)  'Pe 02/12/90
  3856. 20110 END SUB
  3857. 20140 ' $SUBTITLE: 'GetArc - sub to get what files to verbose list'
  3858. ' $PAGE
  3859. '
  3860. '  NAME    -- GetArc
  3861. '
  3862. '  INPUTS  --     PARAMETER                    MEANING
  3863. '                 ZWasQ                       NUMBER OF ENTRIES TYPED
  3864. '                 ZUserIn$()                  ENTRIES TYPED
  3865. '
  3866. '  OUTPUTS --
  3867. '
  3868. '  PURPOSE --  Process the V)erbose list command.
  3869. '              Takes what user types and tries to list it.
  3870. '
  3871.       SUB GetArc STATIC
  3872. 20141 IF ZAnsIndex >= ZLastIndex THEN _
  3873.          CALL QuickTPut1 ("Default extension is "+ZDefaultExtension$)
  3874.       ZOutTxt$ = "View what text file or compressed file(s)" + ZPressEnterExpert$  ' Bh 110690
  3875.       CALL PopCmdStack
  3876.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  3877.          EXIT SUB
  3878. 20142 ZViolation$ = "View ARC"
  3879.       WasX = ZAnsIndex
  3880.       FOR ZAnsIndex = WasX TO ZLastIndex
  3881.          GOSUB 20143
  3882.          IF ZSubParm < 0 THEN _
  3883.             ZAnsIndex = ZLastIndex + 1
  3884.       NEXT
  3885.       IF ZLastIndex > 1 THEN _
  3886.          EXIT SUB _
  3887.       ELSE GOTO 20141
  3888. 20143 ZWasZ$ = ZUserIn$(ZAnsIndex)
  3889.       WasZ$ = ZWasZ$
  3890.       CALL AllCaps (ZWasZ$)
  3891.       CALL BreakFileName (ZWasZ$,Drive$,Prefix$,Ext$,ZFalse)
  3892.       IF Ext$ = "" THEN _
  3893.          Ext$ = ZDefaultExtension$ : _
  3894.          ZWasZ$ = ZWasZ$ + "." + ZDefaultExtension$
  3895.       IF INSTR("DAT,BIN,EXE,COM,GIF,MAC,TIF,PIC,",Ext$+",") > 0 THEN _
  3896.  CALL QuickTPut ("Wrong format; I can't display files with " +Ext$ + " extensions",1) : _   ' Bh
  3897.          RETURN
  3898. '     IF Ext$ = "ARC" _     ' I commented these lines out  ' Bh 110790
  3899. '     OR Ext$ = "DOC" _     ' Bh 110690
  3900. '     OR Ext$ = "LZH" _
  3901. '     OR Ext$ = "PAK" _
  3902. '     OR Ext$ = "TXT" _     ' Bh 110690
  3903. '     OR Ext$ = "ZOO" _
  3904. '     OR Ext$ = "ZIP" _
  3905. '     OR Ext$ = "DWC" THEN _
  3906. '             ARK = ZTrue ELSE _
  3907. '        CALL QuickTPut1 ("Only ARC,DOC,LZH,PAK,TXT,ZOO,ZIP or DWC  files can be viewed") : _  ' Bh 110690
  3908. '              RETURN
  3909.       ZLastExt$ = Ext$
  3910.       ZFileNameHold$ = ZWasZ$
  3911.       ZFileName$ = ZWasZ$
  3912.       CALL BadFile (Prefix$,BadFileNameIndex)
  3913.       ON BadFileNameIndex GOTO 20144,20146,20147
  3914. 20144 CALL BadFile (ZFileName$,BadFileNameIndex)
  3915.       ON BadFileNameIndex GOTO 20145,20146,20147
  3916. 20145 CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount + (NOT ZSysop),ZTrue,"V")
  3917.       IF ZOK THEN _
  3918.          GOTO 20148
  3919. 20146 ZWasZ$ = WasZ$ + _
  3920.            " isn't here! I don't think I have it." + ZCrLf$  ' Bh
  3921.       CALL UpdtCalr (ZWasZ$,2)
  3922.       ZOutTxt$ = ZWasZ$ + _
  3923.            " Try again; maybe you misspelled" + ZPressEnterExpert$   ' Bh
  3924.       ZSubParm = 1
  3925.       CALL TGet
  3926.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  3927.          RETURN
  3928.       ZUserIn$(ZAnsIndex) = ZUserIn$(1)
  3929.       GOTO 20143
  3930. 20147 CALL SecViolation
  3931.       IF ZDenyAccess THEN _
  3932.          EXIT SUB
  3933.       GOTO 20146
  3934. '20148 CALL QuickTPut1 (ZFileNameHold$ + " contains the following:")  ' Bh 110690
  3935. 20148 CALL ViewArc      ' This is in RBBSSUB4.BAS    ' Bh 110690
  3936.      IF Ext$ = "ARC" _                           ' Bh 110690
  3937.      OR Ext$ = "LZH" _
  3938.      OR Ext$ = "PAK" _
  3939.      OR Ext$ = "ZOO" _
  3940.      OR Ext$ = "ZIP" _
  3941.      OR Ext$ = "DWC" THEN _
  3942.       CALL ViewTxt        'Pete Eibl RBBSSUB1.BAS
  3943.       CALL UpdtCalr ("Viewed " + ZFileNameHold$,1)              ' Bh 110790
  3944.       RETURN
  3945.       END SUB
  3946. 20235 ' $SUBTITLE: 'BadName - subroutine to find bad file names'
  3947. ' $PAGE
  3948. '
  3949. '  NAME    -- BadName
  3950. '
  3951. '  INPUTS  --     PARAMETER                    MEANING
  3952. '               ZActiveMessageFile$
  3953. '               ZActiveUserFile$
  3954. '               ZCallersFile$
  3955. '               ZCmntsFile$
  3956. '               CONFIG.FILEANAME$
  3957. '               ZMainMsgBackup$
  3958. '               ZMainMsgFile$
  3959. '               ZMaxViolations
  3960. '               ZPswdFile$
  3961. '               ZRBBSBat$
  3962. '               ZRCTTYBat$
  3963. '               ZSubDir$()
  3964. '               ZSubDirIndex
  3965. '               ZViolation$
  3966. '               ZViolationsThisSession
  3967. '               ZWasZ$                          NAME OF FILE
  3968. '
  3969. '  OUTPUTS  -- BadFileNameIndex         1 = FILE NAME IS OK
  3970. '                                       2 = SECURITY BREACH TRIED
  3971. '              ZViolationsThisSession     NUMBER OF VIOLATIONS
  3972. '              FileSpec$                   NAME OF FILE
  3973. '
  3974. '  PURPOSE -- To protect RBBS-PC against the use of bad file names
  3975. '             to either crash the system or to breach RBBS-PC's security
  3976. '
  3977.       SUB BadName (BadFileNameIndex) STATIC
  3978. '
  3979. '
  3980. ' *  TEST FOR SYSTEM FILE ATTEMPT
  3981. '
  3982.       BadFileNameIndex = 2
  3983.       ZWasZ$ = ZFileName$
  3984.       CALL BreakFileName (ZFileName$,DR$,Prefix$,Extension$,ZFalse)
  3985.       IF LEN(Extension$) = 3 THEN _
  3986.          IF INSTR("DEF,MNU,OLD,PUI,BAK,",Extension$+",") > 0 THEN _
  3987.             EXIT SUB
  3988.       ZOK = 0
  3989.       CALL FileNameCheck (ZActiveMessageFile$,Prefix$,Extension$)
  3990.       CALL FileNameCheck (ZActiveUserFile$,Prefix$,Extension$)
  3991.       CALL FileNameCheck (ZCallersFile$,Prefix$,Extension$)
  3992.       CALL FileNameCheck (ZCmntsFile$,Prefix$,Extension$)
  3993.       CALL FileNameCheck (ZFileSecFile$,Prefix$,Extension$)
  3994.       CALL FileNameCheck (ZMainMsgBackup$,Prefix$,Extension$)
  3995.       CALL FileNameCheck (ZOrigMsgFile$,Prefix$,Extension$)
  3996.       CALL FileNameCheck (ZOrigUserFile$,Prefix$,Extension$)
  3997.       CALL FileNameCheck (ZPswdFile$,Prefix$,Extension$)
  3998.       CALL FileNameCheck (ZRBBSBat$,Prefix$,Extension$)
  3999.       CALL FileNameCheck (ZRCTTYBat$,Prefix$,Extension$)
  4000.       CALL FileNameCheck (ZConfigFileName$,Prefix$,Extension$)
  4001.       IF ZOK > 0 THEN _
  4002.          EXIT SUB
  4003.       BadFileNameIndex = 1
  4004.       END SUB
  4005. 20240 ' $SUBTITLE: 'FileNameCheck - checks file match except for drive'
  4006. ' $PAGE
  4007. '
  4008. '  NAME    -- FileNameCheck
  4009. '
  4010. '  INPUTS  --     PARAMETER                    MEANING
  4011. '               CheckThis$           Name of file to check
  4012. '               Pref2$               Prefix to match against
  4013. '               Ext2$                Extension to match against
  4014. '
  4015. '  OUTPUTS  -- ZOK                    1 if got match
  4016. '
  4017. '  PURPOSE -- Checks for match on both prefix and extension of a file
  4018. '             name.   Used to catch match on system files not to be
  4019. '             downloaded.
  4020. '
  4021.       SUB FileNameCheck (CheckThis$,Pref2$,Ext2$) STATIC
  4022.       IF ZOK > 0 THEN _
  4023.          EXIT SUB
  4024.       CALL BreakFileName (CheckThis$,DR$,Pref1$,Ext1$,ZFalse)
  4025.       IF Pref1$ = Pref2$ THEN _
  4026.          IF Ext1$ = Ext2$ THEN _
  4027.             ZOK = 1
  4028.       END SUB
  4029. ' $SUBTITLE: 'AbortLogOff -- RBBS-PC common routine to Abort Autologoff'
  4030. ' $PAGE
  4031. '
  4032. '
  4033.       SUB AbortLogOff STATIC
  4034.       ON ZSubParm GOTO 20300,20326
  4035. '
  4036. ' *
  4037. ' *  COMMON INPUT ROUTINE
  4038. ' *
  4039. 20300 CALL Carrier
  4040.      IF ZSubParm = -1 OR ZAutoEnd = 0 THEN _
  4041.         EXIT SUB
  4042.      ZLinesPrinted = 0
  4043.      ZDisplayAsUnit = ZFalse
  4044.      InStack = ZFalse
  4045.      TOA! = FRE("A")
  4046. Temp! = ZAutoLogoff!
  4047. ZAutoLogoff! = TIMER + 15   'Pe 02/05/90 
  4048. CALL CheckTime(ZAutoLogoff!, TempElapsed!,3)
  4049.      ZWasA = 0
  4050.      ZWasB = 0
  4051.      ZWasC = 0
  4052.      ZWasQ = 1
  4053.      Parm = 0
  4054.      EOL = ZFalse
  4055.      ZYes = ZFalse
  4056.      ZUserIn$ = ""
  4057.      SleepWarn = ZTrue
  4058.      NO = ZFalse
  4059.      CALL ColorPrompt (ZOutTxt$)
  4060.      ZOutTxt$ = ZOutTxt$ + _
  4061.           MID$("! !  ",2*ZTurboKey+1,2)
  4062.      ZSubParm = 4
  4063.      StopSave = ZStopInterrupts
  4064.      ZStopInterrupts = ZTrue
  4065.      CALL TPut
  4066.      ZStopInterrupts = StopSave
  4067.      IF ZSubParm = -1 THEN _
  4068.         EXIT SUB
  4069. 20323 IF ZPromptBell THEN _
  4070.         IF ZLocalUser THEN _
  4071.            BEEP_
  4072.         ELSE CALL PutCom(ZBellRinger$)
  4073. 20325 CALL Carrier
  4074.      IF ZSubParm = -1 THEN _
  4075.         EXIT SUB
  4076.      IF (NOT ZForceKeyboard) AND LEN(ZCommPortStack$) > 0 THEN _
  4077.         ZwasY$ = LEFT$(ZCommPortStack$,1) : _
  4078.         ZCommPortStack$ = RIGHT$(ZCommPortStack$,LEN(ZCommPortStack$)-1) : _
  4079.         GOTO 20341
  4080.      IF ZLocalUser THEN _
  4081.         CALL FindFKey: _
  4082.         IF ZSubParm < 0 THEN _
  4083.            EXIT SUB _
  4084.         ELSE GOTO 20326
  4085.      CALL EofComm (Char)
  4086.      IF Char <> -1 THEN _
  4087.         CALL GetCom(ZWasY$) : _
  4088.         IF ZSubParm = -1 THEN _
  4089.            EXIT SUB _
  4090.         ELSE GOTO 20341
  4091.      CALL CheckTime (ZAutoLogOff!,TempElapsed!,3)
  4092.      IF TempElapsed! < 30 THEN _
  4093.         IF TempElapsed! <= 0 THEN _
  4094.            CALL UpdtCalr ("Used AutoLogoff",2) :_
  4095.            ZSubParm = -1 : _
  4096.            EXIT SUB _
  4097.         ELSE IF SleepWarn THEN _
  4098.                 SleepWarn = ZFalse : _
  4099.                 ZOutTxt$ = " 15 seconds to AutoLogOff" : _
  4100.                 CALL RingCaller
  4101.      CALL FindFKey
  4102.      IF ZSubParm < 0 THEN _
  4103.         EXIT SUB
  4104. 20326  CALL QuickTPut (".",0)
  4105.       Call DelayTime (1)
  4106.       ZWasY$ = ZKeyPressed$
  4107.      IF ZWasY$ <> "" THEN _
  4108.         GOTO 20345
  4109.      SendRemote = ZTrue
  4110.      CALL GoIdle
  4111.      GOTO 20325
  4112. 20341 SendRemote = ZRemoteEcho
  4113. 20345 WasX$ = ZWasY$
  4114.      IF ZWasY$ = ZCarriageReturn$ THEN _
  4115.         ZAutoLogoff! = Temp! : _              'Pe 02/28/90
  4116.         GOTO 20347
  4117.  IF ZWasY$ <> ZCarriageReturn$ THEN _
  4118.         GOTO 20325 
  4119. 20347 ZTurboKey = ZFalse          ' Carriage Return Handler
  4120.      ZHidden = ZFalse
  4121.      IF ZNoAdvance THEN _
  4122.         ZNoAdvance = ZFalse : _
  4123.         GOTO 20325 _
  4124.      ELSE CALL LPrnt (ZCrLf$,0) : _
  4125.           GOSUB 20351 : _
  4126.           GOTO 20370
  4127. 20351 IF NOT SendRemote THEN _
  4128.         RETURN
  4129. 20353 CALL PutCom (WasX$)
  4130.      RETURN
  4131. 20370 IF SendRemote THEN _
  4132.         IF ZLineFeeds THEN _
  4133.            CALL PutCom (ZLineFeed$)
  4134.         ZAutoLogoff! = Temp!
  4135.         ZWasQ = 0
  4136.        END SUB
  4137.